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(Vol. II), presents technical appendixes 
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Force Enlistment Programs Simulation. 
It is divided into four’ sections. 
Appendix A contains a guide to assist 
users of the simulation methodology. In 
addition to a detailed example of the 
use of the simulation, it discusses some 
of the potential uses not explored in 
volume I. Appendix B is a description 
of the methods used in computing the 
active-duty inventories and continuation 
behavior. It also lists some of the 
important active-duty data elements used 
in the simulation, as well as the major 
computer programs used to generate these 
data. Appendix C presents similar 
descriptions for the SELRES data. A 
flowchart of the simulation methodology 
and annotated versions of the simulation 
programs appear in appendix D. 
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APPENDIX A 


USER'S GUIDE TO THE 
: TOTAL FORCE ENLISTMENT PROGRAMS SIMULATION 


This appendix provides information on how to use the Total Force 
Enlistment Programs Simulation. For the most part, its use is self 
explanatory. The example and discussion below is intended to reduce the 
ambiguities that may arise regarding how to pose a research or policy 
question so that the simulation methodology gives an appropriate answer. 


The Total Force Enlistment Programs simulation is a menu-oriented 
procedure that gives the user a sequence of choices regarding inputs to 
the simulation. The outputs of the simulation are files in the current 
directory of the user describing the inputs chosen by the user, 
resulting inventories, and comparisons between results of two 
simulations. These files must be directed to the printer by users 
desiring hard copy versions of the results. Alternatively, users 
located at a remote site employing a modem hook-up can list and capture 
or print these files. 


The user of the simulation will need at least 1,500 blocks of 
available disk storage on the CNA unclassified computer system to be 
sure of having enough space to run both the active and reserve 
simulations and to compare the results of two alternative runs. 
However, the simulation may be run successfully with as few as 
800 blocks of available storage. The simulation is best accessed 
through a command procedure called "SIM" that appears in appendix D. 
Upon typing "SIM" at the prompt, the user will be able to execute the 
various programs that comprise the simulation methodology. The 
following example illustrates the use of the simulation. 


USING THE SIMULATION 


After starting the simulation, the following screen will appear. 
To exit the program during the course of any simulation requires using 
the interrupt command 'ctrl-y'. Use of this interrupt will cause screen 
1 to reappear. 


- Execute Active simulation program 

- Execute Reserve simulation program 

Execute program to compare two Active runs 
Execute program to compare two Reserve runs 
Finish this session 


Ww eWNY — 
t 


Enter your selection __ 


SCREEN 1 
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On selecting option 1, the user executes the active duty 
simulation. When finished, the user will confront the same menu of 
choices again. The active duty simulation is discussed first, followed 
by the reserve simulation. 


ACTIVE FORCE SIMULATION 


Hit return to start run 
SCREEN 2 


The next choice that the user has is which allocation profile to 
use in the simulation. The default allocation of accessions to 
enlistment programs and ratings is derived from the FY 1985 PRIDE data, 
with the exception of the Prior Service program. Most applications will 
utilize a user-created allocation matrix (option 2) that has been 
customized to reflect an accession profile that the user wants to 


1 - Use the default allocation matrix 
2 - Selected a user created allocation matrix 


Enter your selection: 
SCREEN 3 


analyze. When option 2 is chosen, a numbered list of previously created 
allocation matrices in the default directory appears on the screen. 
These files must have been created in previous runs of the simulation. 
An example appears below. 


- AMPLUSY 

- BASE 

- BASE_88A 
DEFAULT_85P 
NEW1 

- NO_SE_CLG 


Aum Sewn 
' 


Enter you: selection: 


SCREEN 4 


The percentage of accessions in each enlistment program (except 
Navy Sea College) and rating group is determined by this choice. The 
next user input is the total number of accessions in each year, less any 
Navy Sea College accessions. The simulation treats these as accessions 
rather than end-of-fiscal-year inventories, and requests inputs for the 
total number of accessions by year as follows: 


- Current FY total recruits 1986 


1 
2 - Outyear 1 total recruits 1987 
3 - Outyear 2 total recruits 1988 
4 - Outyear 3 total recruits 1989 
Total accessions 5 - Outyear 4 total recruits 1990 
minus Sea College 6 - Outyear 5 total recruits 1991 
7 - Outyear 6 total recruits 1992 
8 - Outyear 7 total recruits 1993 
9 - Outyear 8 total recruits 1994 
10 - Outyear 9 total recruits 1995 


Enter number of outyear to change or <Return> 
SCREEN 5 
LOS 1 Sea Coilege program end-of-fiscal-year survivors, rather 
than accessions, are input similarly. For each simlation reported in 


volume I, 90 percent of Sea College accessionsa re assumed to survive to 
the end-of-fiscal-year. 


- Current FY total recruits 1986 


_ 


~- Outyear 9 total recruits 1995 


1 
2 - Outyear 1 total recruits 1987 
3 - Outyear 2 total recruits 1988 
4 - Outyear 3 total recruits 1989 
Inputs for 5 ~- Outyear 4 total recruits 1990 
Sea College 6 - Outyear 5 total recruits 1991 
7 - Outyear 6 total recruits 1992 
8 - Outyear 7 total recruits 1993 
9 - Outyear 8 total recruits 1994 
0 9 


Enter number of outyear to change or <Return> 


SCREEN 6 


At this point, the allocation percentages by enlistment program 
and rating are applied to the total inputs, yielding the number of 
accessions in each enlistment program and rating group. As a check on 
the feasibility of the allocation by rating group, the user can request 


A-3 


(on screen 7) to compare the proposed allocation of accessions by rating 
group to planned (FY 1988) allocations of A-school seats to USN 
recruits. 


Would you like to view the comparison of 
allocations to planned school seats (Yes or No)? ___ 


SCREEN 7 


Answering this question 'Y' yields a presentation like the one in 
screen 8. As presently implemented, this display is only for the user's 
information in connection with potential reallocations of accessions 
across rating groups. It can simply be ignored if the user desires. 

For the example presented below, the allocation of FY 1988 accessions to 
the AB rating group is 223 short of the planned seats, a difference of 
21 percent. 


No schoo] req 7800 AN No school Req 3200 DM -93 -3% 2200 MS 

-223 -21% 6700 AB + 28 -7% 1900 DP -1 -1% 3300 MU 

-1 0% 6600 AC -2 0% 1010 DS No school req 1400 NC 

-167 -5% 6080 AF -253 8% 4100 EM -52 -2% 0300 OS 

0 0% 7100 AG -6 0% 3800 EN 0 0% O450 OT 

-30 -44 7300 AK -2 0% 5380 EQ -23 -16% 2700 PC 

~5 0% 6500 AO -337 -9% 1000 ET -3  -1% 7600 PH 

-1 0% 7500 AS -90 -17% 0350 EW 0 0% 1080 PI 

-155 -5% 6280 AV No school req 5000 FN 0 0% 4600 PM 

-44  -7% 6400 AW -77  -3% 0800 FT -51 ~8% 1800 PN 

-2 0% 7400 AZ -5 OZ 0600 GM -1 0% 7000 PR 

No school req 0100 BM -90 -14% 4400 GS -1 0% 0200 QM 

-2 0% 4000 BT -7 OZ 8000 HM -145 -5% 1500 RM 

No school req 6000 CN 1147 15424 4300 HT 0 0% 2500 RP 

0 0% 1622 CTA -2 0% 2300 IS' No school req 3600 SN 

-2 0% 1666 CTI 3 -3% 2600 JO -3 0% 2490 SH 

0 0% 1633 CTM 0 0% 3100 LI -1 0% 2000 SK 

-10 -4% 1644 CTO No school req 1750 LN -1 0% 0250 SM 

-1 0% 1655 CTR No school req 0150 MA -111 -5% O400 ST 

-2 0% 1611 CIT 0 0% 4700 ML No school req 7200 TD 

-58 -4%Z 5080 CU ~-243 ~-5% 3700 MM -7 -1% 0500 TM 

-2 0% 8300 DN 0 0% 0900 MN 0 0% 5800 UT 

-31 -10% 2100 DK -1 0% 3900 MR ~69 -5% 1700 YN 
SCREEN 8 


To alter these accession profiles by enlistment program or rating 
group for any year, the user hits <Return> after viewing the above 
comparison, and answers 'Y' to the following question. 


Would you like to change Program or Rating mixes for any year 
(Yes or No)? ___ 


SCREEN 9 


The year for which the accession profile is to be changed is then 
input in response to the following screen. 


- Current FY 1986 
- Outyear 1 1987 
- Outyear 2 1988 
Outyear 3 1989 
Outyear 4 1990 
- Outyear 5 1991 
- Outyear 6 1992 
- Outyear 7 1993 
9 - Outyear 8 1994 
10 - Outyear 9 1995 


ONOMN LSWD — 
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Enter your selection or (99 to end): __ 
SCREEN 10 
If year 3 were chosen, the following would then appear. 
Selection for year 1988 
1 - Change program mixes 
2 - Change rating mixes 
9 - End changing this outyear 


Enter your selection: 


SCREEN 11 


wt we ee SS Be es ee ee 


If a reallocation of accessions among enlistment programs is 
desired, the user types '1' and views screen 12: 


Orig Change Diff 

1 - 4Y0 Program WW 512 44512 0 
2 - Active Mariner Program 13,224 13,224 0 
3 - 5 & 6Y0O Program 14,988 14,988 0 
4 - Prior Service Program 6,251 6,251 0 
5 - TAR Program 1,271 1,271 0 
6 - Sea College Program 2,700 2,700 0 
7 - Any new program 0 0 0 
Totals 82,946 82,946 0 


Enter Program to change or <Return> ___ 


SCREEN 12 


Selecting a program by number, the user may change the number of 
accessions as desired. The program keeps track of tne differences so 
that changes may be analyzed more easily. The new inputs are used to 
recompute the allocation percentages for that year. The percentage 
distribution of accessions across rating groups within each enlistment 
program is unchanged in this process. 


If a reallocation of accessions among ratings is desired, the user 
types '2' and views: 


. aoa 
se 


a wy YT Eke Fem) 


1. 7800 AN 20. 1611 CIT 39. 2600 JO 58. 0200 QM ?, 
2. 6700 AB 21. 5080 CU 40. 3100 LI 59. 1500 RM ” 
3. 6600 AC 22. 8300 DN 41. 1750 LN 60. 2500 RP . 
4. 6080 AF 23. 2100 DK 42, 0150 MA 61. 3600 SN i 
5. 7100 AG 24. 3200 DM 43. 4700 ML 62. 2490 SH ‘ 
6. 7300 AK 25. 1900 DP 4H, 3700 MM 63. 2000 SK ; 
7. 6500 AO 26. 1010 DS 45. 0900 MN 64. 0250 SM ; 
8. 7500 AS 27. 4100 & 46. 3900 MR 65. 0400 ST : 
9. 6180 AV 28. 3800 EN 47. 2200 MS 66. 7200 TD : 
10. 6400 AW 29. 5380 EQ 48. 3300 MU 67. 0500 TM » 
11. 7400 AZ 30. 1000 ET 49. 1400 NC 68. 5800 UT : 
12. 0100 BM 31. 0350 EW 50. 0300 OS 69. 1700 YN : 
13. 4000 BT 32. 5000 FN 51. 0450 OT : 
14. 5000 CN 33. 0800 FT 52. 2700 PC ‘ 
15. 1622 CTA 34. 0600 CM 53. 7600 PH \ 
16. 1666 CTI 35. 4400 GS 54. 1080 PI \ 
17. 1633 CTM 36. 8000 1M 55. 4600 PM , 
18. 1644 cro 37. 4300 HT 56. 1800 PN . 
19. 1655 CTR 38. 2300 IS 57. 7000 PR 


Input Rating (99 to end) ___ 


SCREEN 13 


The user may select up to 9 ratings at a time for changes. In this 
example, 5 rating groups were chosen yielding the following display. To 
change the number of accessions in the AB rating group, 4Y0O program, the 
user would selects row 1, colum 1 and enter the new number. The total 
is automatically adjusted. If the user changes only the total column 


eee ee ee oe eee ee ee ee ee ee F 


4YO ACT MA 5&6YO PR SER TARS SEA CO OTHER TOTAL _MAX 


i dnt i 


6700 AB 696 0 0 126 0 0 0 822 1,045 ; 
6400 AW = 383 93 0 69 36 0 0 581 625 ( 
1611 CTT 265 0 0 15 0 0 0 280 282 ’ 
1000 ET 0 211 2,1 %e 123 68 0 0 3,174 3,511 
3100 LI 33 0 0 8 0 0 0 4 44 
Enter ROW and COLUMN to change or <Return> ROW = =COLUMN 
SCREEN 14 


for a rating, the new total will be distributed across enlistment 
programs in the same proportion as the original total. The MAX column 


A-7 
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contains the number of A-school seats allocated for FY 1988, and is 
provided for information only. These procedures may be executed as many 
times as desired, until the user is satisfied with the ullocation of 
accessions in the chosen year. On exiting from the changes (for all 
years) the user is given the opportunity to save the changes. 


Would you like to save this allocation (Yes or No)? {f 


Enter a name to save this allocation under 


SCREEN 15 


The version of the simulation using aggregate data frovides three 
alternative years of continuation behavior. They are chosen from the 
following menu. 


Choose the transition rates you desire for this run 


1 - Transitions from 80 to 81 
2 - Transitions from 84 to 85 
3 - Transitions from 85 to 86 


Enter your selection: 


SCREEN 16 


The version of the simulation using indivdiual data presently 
provides only FY 1986 continuation behavior. 


The simulation nuw executes as shown on screen 17, producing a 
file of simulated inventories that will be saved with a name chosen by 
the user. It is stored in binary format for use by the COMPARE 
procedure. 


Please wait while simulation takes place 
Beginning to transition the history 
Finished creating the outyear inventories 


Beginning to add paygrade to outyear inventories 
Finished adding paygrade to outyear inventories 


Beginning to write results to disk 
Finished writing results to disk 


Enter a filename for storing the results (for use later in the COMPARE 
run) P 


SCREEN 17 


A second file called ACTIVE.DAT is written to disk and may be 
printed to see the allocation of new accessions and resulting simulated 
inventories for each year. A file of active duty losses by rating group 
and enlistment program is also produced for use in the reserve 
similation. This finishes the active duty simulation. 

Finish of Active Force Simulation 


Hit return to finish 
SCREEN 18 


The user now chooses among the options on SCREEN 1. Choosing to 
run the reserve simulation (option 2) brings up the following screen. 
Reserve Force Simulation 


Hit return to start run 
SCREEN 19 


The total number of SAM accessions are entered on screen 20. Like 
active duty accessions, these should not be adjusted for within-year 
attrition. As described in volume I, the simulation takes 90 percent of 
these numbers as LOS 1 survivors. 


—~ 


- Outyear 9 total recruits: 


1 - Current FY total recruits: — 
2 - Outyear 1 total recruits: — 
3 - Outyear 2 total recruits: ——__ 
4 ~ Outyear 3 total recruits: ——__ 
Input for SAMs 5 - Outyear 4 total recruits: ——__ 
6 - Outyear 5 total recruits: —__ 
7 - Outyear 6 total recruits: ——_ 
8 - Outyear 7 total recruits: ——__ 
9 - Outyear 8 total recruits: — 
0 9 Bear 
<Return> 


Enter number of outyear to change of 


SCREEN 20 


The residual category of OTHER SELRES accessions is input on a 
screen similar to screen 20. Like Sea College accessions, these should 
include end-of-fiscal-year LOS 1 survivors. 


The user may now change the rating mix of SAM accessions by 
answering 'Y' to screen 21. This procedure is the same as changing 
rating distributions for the active simulation, except that only SAM 
accessions may be reallocated. 

Would you like to change SAM mixes (Yes or No)? 
SCREEN 21 

The reserve simulation then executes, writing the results to two 
disk files. The user is asked to name a binary version of the output 
file for use in later comparisons. A second version called RESERVE.DAT 


is produced and may be printed or edited to examine the simulated 
inventories. 


Enter a filename for storing the results 
(for use later in the COMPARE run) 


SCREEN 22 


The reserve simulation is now finished. 


A-10 


Finish of reserve force simulation 


Hit return to finish 


SCREEN 23 


A program to compare the results of two simulations may then be 
executed by choosing options 3 or 4 on screen 1. 


This will cause a list of existing active duty or reserve 
simulation output files to be displayed as on screen 24. Selection of 
two files by number yields a detailed comparison by paygrade and rating 
group for each outyear. This is written to disk as COMPARE ACT.DAT or 
COMPARE_RES.DAT. 


1 - AMPLUS4 
2 - BASE! 
3 - BASE_88A 
4 —- EXAMPLE 
5 - NO_SEACG 
Enter selection for base file: _ Compare file: __ 
SCREEN 24 


The primary use of the simulation is to examine the effects of 
changing the mix of active duty accessions among enlistment programs. 
The easiest way to do this is to use the options described on screens 
9-12. However, this procedure will generally shift accessions among 
rating groups. This happens because ratings do not have accessions in 
each of the enlistment programs and the allocation of accessions to 
rating groups within an enlistment program is fixed by the allocation 
matrix in use. For example, in alternative 4 of volume I, accessions 
are redistributed from the 4Y0 program to the Prior-Service program. 
The 5YO ratings have no 4YO enlistments but do have Prior-Service 
enlistments. Such ratings will grow as the Prior-Service program grows 
relative to the 4Y0O program. The user may circumvent this 
redistribution among ratings by reallocating accessions among enlistment 
programs for each of the ratings, making sure to keep rating sizes fixed 
in the process. 


For the Sea College program, the number of accessions must be 


changed on screen 6 to have the effect consistently included in the 
simulation. In fact, the simulation will not allow the user to change 
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the number of Sea College accessions on screen 12. This is because the 
Sea College program allocations to the General Detail (GENDET) 
categories, based on the distribution of GENDETs among the Seaman, 
Airman, and Fireman categories, is done outside the allocation process 
used for other enlistment programs. 


A second use of the simulation is long-term planning for the 
number of accessions required to meet a given inventory objective by a 
certain time. This can be accomplished by varying the total accessions 
until the appropriate inventory level is reached. In the process, the 
effect of changes in the number of active duty accessions on SELRES 
inventories can be estimated. 


Using continuation rates associated with aggregate data, the 
simulated effects of redistributing accessions among rating groups are 
likely to be misleading because of the fact that only net continuation 
behavior is observed. That is, lateral transfers between ratings are 
not tracked in this approach. The effects will be particularly 
misleading when only the first three years of continuation are observed, 
because GENDETs make lateral transfers to rating groups at relatively 
high ratings during the first three years of service. For this reason, 
the net continuation rates for the ratings are not representative of 
individuals beginning service with initial training in those ratings. 
The continuation rates based on individual data do not pose this 
difficulty, and be used to more reliably estimate changes in a rating 
group associated with changing the number or mix of enlistments into 
that rating. Such use of the simulation should be pursued cautiously 
because of the relative validity of rating sizes and the impact of 
unpredictable short-term corrective actions applied to particular 
ratings. 
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APPENDIX B 


ACTIVE-DUTY DATA AND CALCULATIONS 


The Total Force Enlistment Program simulation requires information 
on historical inventories and continuation behavior of enlisted 
personnel by program of enlistment, rating, and length of service. This 
information was obtained by extracting end-of-fiscal-year inventories 
from CNA Enlisted Master Record (EMR) files and storing the information 
in two types of data tables. For aggregate continuation behavior, and 
inventory calculations, counts of indivdiuals by program of entry, 
rating, paygrade, and length of service (LOS) are produced. Tables for 
each fiscal year 1979 to 1986 were loaded into APL files as matrices. 
For individual continuation behavior, individual observations for the 
end of fiscal years 1985 and 1986 are summed into arrays by enlistment 
program, rating, transition type, and LOS. The transition types include 
within rating continuation, lateral transfer into and out of the begin- 
year rating, and loss from active duty. 


The advantage of storing the yearly data as APL matrices is that 
each years' inventory, as a single data object, can be manipulated-- 
summed or extracted across the four dimensions--by single APL 
operations. Also, year-to-year comparisons, like transition rates, can 
be performed on whole matrices at a time rather than iterative 
operations that would perform the operations cell-by-cell. 


The program shown in annex B-1 extracts inventory data from the 
EMRs. Standard methods are used in the program to determine rating, 
paygrade, and LOS. Individuals are initially divided into 129 ratings, 
although later analysis required that they be merged into 69 rating 
groups. These 69 rating groups correspond to the separate paths 
available to enlisted personnel advancing into chief (E7 to £9) 
ratings. The paygrades are the nine pay levels E1 through E9. LOS is 
determined by using the Active Duty Service Date (ADSD). Individuals 
are placed in one of 31 LOS categories, 1 through 30, and 31 and greater 
years of service, by measuring time between ADSD and the date of the 
end-of-FY EMR snapshot. 


The entry program is determined primarily by the PRCGRAM-ENLISTED- 
FOR field in the SPECIAL-PROGRAM-CODES (SPC) section of the EMR, 
although other criteria were used when SPC code was missing. Five 
enlistment entry programs were defined for those with length of service 
of zero to nine years: four-year obligor (4Y0), Active Mariner (AM), 
five/six-year obligor (5/6 YO), Prior-Service (PS), and TAR Enlistment 
Program (TAR) (enlisted personnel of LOS ten years and greater were not 
divided into entry programs). Enlisted personnel who could not be 
classified by entry program were excluded from the analysis. This was 
more likely for the higher LOS cells of earlier inventory years, 
corresponding to accessions during a time when enlistment programs were 


not as frequently recorded. By 1985, only about 50 individuals are 
excluded. Figure B-1 presents a flow chart of the procedure used to 
determine original enlistment program for each individual. The special 
program ang type acquisition codes used for classification are in 

table B-1. 


TABLE B-1 


ENLISTMENT PROGRAM CLASSIFICATION CODES 


Enlistment program SPC Type acquisition 
4YO H4FKE 18, 48 
Active Mariner MZW 

6Y0 G5AB 

Prior-Service S87NQL 

TAR Y 19 


The APL inventory matrices are stored in the APL file, 
[GARVEYK .APL ]SEPTEMBER.AIX. Other historical data, such as PRIDE data, 
and new accession prior service, are also necessary in producing data 
for the model and are stored as matrices of identical shape as the main 
inventory data. They also reside in APL files. APL files are a 
collection of "components" that are referenced by number. All APL files 
used in the analysis have the same organization: an explanatory index 
as the first component, with the dc’.a stored by year in components two 
through nine, starting with 1986 d:*.- in component two, 1985 in three, 
and so on, in reverse chronological] order. 


Continuation Behavior From Aggregate Data 


Given the EMR inventories and other historical data tabulated by 
enlistment program, rating and LOS, aggregate continuation behavior can 
be computed. Annex B-2 lists the annotated APL programs used for this 
purpose. The function XTRANS TO computes transition and addition rates 
for each combination of enlistment program, rating group, and LOS for 
any two adjacent years for which inventories are available. The 
earliest such year is fiscal 1980 and the latest year is fiscal 1985. 


1. Computation of continuatiun rates by enlistment program reveals that 
some simple continuation rates exceed 1.0 in the early LOS cells. This 
must be due to changes in the program-enlisted-for field of the EMR when 
individuals switch from regular active duty to TAR. A detailed 
investigation of these changes is left for future research. 
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FIG. B-1: (Continued) 


The inventory tabulations are prepared for the computation of 
transition and addition rates by the functions BUILD LOS1 and MAKE _ 
ALLOCATION. PRIDE data are used to distribute the LOS1 inventory by 
rating and enlistment program. In this process, all prior service 
accessions are placed in LOS1, to be spread back out over the 
appropriate LOS cells in the simulation. For the LOS1 to LOS3 
transitions, the results of BUILD LOS1 are used in the calculations of 
XTRANS_TO. 


After setting up the data, the first step in the calculation of 
aggregate transition rates is to subtract new Prior Service accessions 
from the inventory of the end-year to produce the numerator of the 
transition rate. This is necessary because including new Prior-Service 
accessions by LOS would exagerate transition rates for that cell by 
counting accession behavior as continuation. Following this, the 
function TRANS DIVIDE BY divides the end-year inventory by the begin- 
year inventory and produces both the transition and addition rates. 
Where transition rates not exceeding one are computed, the addition rate 
is zero. Otherwise, the addition rate is calculated as the excess in 
the end-year (over the begin-year) divided by the size of the rating in 
the begin-year. In the aggregate transition version of the simulation, 
the addition rate is multiplied by the size of the rating to account for 
lateral transfers. For LOS3 additions, the denominator of the addition 
rate is the size of the total LOS1 inventory one year prior to the begin 
year. 


As it turned out, the large number of lateral rating transfers 
made the results difficult to interpret without collapsing the rating 
dimension. For this reason, the analysis resorted to calculation of 
continuation behavior (keeping the rating dimension) from individual 
observations. 


Continuation Behavior from Individual Behavior 


The calculation of continuation rates using individual 
observations is based on EMR files from September 1985 and 1986. Each 
individual with LOS 3 or greater is identified on the September 1985 EMR 
according to enlistment program, rating and LOS. Those categories are 
established on the same criteria as the inventory tabulation. The 
Status of that individual is then observed on the September 1986 EMR. 
The individual's transition is classified as (1) a loss to active duty 
endstrength, (2) continuation in the same rating, or (3) continuation 
with a change of rating. The rates of occurrence of each transition 
type are tabulated for each cell of the inventory matrix. LOS 1+3 
transitions are derived from comparing FY 1984 PRIDE accessions to 
FY 1986 inventories. Table B-2 contai:.s the end-of-fiscal-year 1985 
inventory of enlisted personnel categorized by enlistment progran, 
rating, and LOS. Rates for the three types of continuation behavior are 
listed in tables B-3 through B-5. Within rating continuation rates are 
in table B-3. The lateral transfer rates by enlistment program, rating, 
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and LOS, in table B-4 are multiplied by the number of expected lateral 
transfers in the corresponding enlistment program and LOS to obtain the 
number of lateral transfers into each rating for each enlistment program 
and LOS. The number of expected lateral transfers in each enlistment 
program and LOS continuation is obtained from the ratio of total lateral 
transfers in the enlistment program and LOS to the number of individuals 
(in the begin year) in that enlistment program and LOS. Active duty 
loss rates by enlistment program, rating and LOS are in table B-5, as 
calculated from individual behavior. 


Other Data 


The paygrade distribution by rating and LOS tabulated for the 
September 1985 EMR appears in table B-6. Prior service accessions are 
allocated to rating groups and LOS (for LOS < 9) according to the 
fractions in table B-7. The distribution is based on the September 1986 
EMR allocation of Prior-Service accessions. Enlisted Programmed 
Authorizations (as of March 1986) are detailed, through FY 1991, in 
table B-8. 
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ANNEX B-1 
PROGRAM LISTING TO EXTRACT AND 
TABULATE ENLISTED MASTER RECORD INVENTORY 


ae AS) caben tae teres : FP LL a a ee A A AT AT mo 


EP Pe ie eA a ee ee eee ew ee ee elm lle eo in ee Or 


LISTING OF COBOL PROGRAM 
TO EXTRACT AND TABULATE 
EMR INVENTORY DATA 


IDENTIFICATION DIVISION. 


PROGRAM-ID. TABLE4. 

AUTHOR. KBGARVEY. 
. INSTALLATION. Center for Naval Analyses. 
: DATE-WRITTEN. OCTOBER 1986. 


ENVIRONMENT DIVISION. 
CONFIGURATION SECTION. 
SOURCE-COMPUTER. VAX11-785(VMS). 
OBJECT-COMPUTER. VAX11-785(VMS). 
SPECIAL-NAMES. COl IS NEW-PAGE. 
INPUT-OUTPUT SECTION. 
FILE-CONTROL. 
SELECT LABFILE ASSIGN TO LFILE. 
SELECT INFILE ASSIGN TO IFILE 
FILE STATUS IS IN-STATUS. 
SELECT OUTFILE ASSIGN TO OFILE 
FILE STATUS IS OUT-STATUS. 
SELECT LISTING ASSIGN TO LISTING. 
DATA DIVISION. 
FILE SECTION. 
* 


FD LABFILE. 
Ol LABREC. 
03 LAB-TITLE PIC Xxx. 
03 LAB-MO PIC X. 
03 LAB-YR PIC 99. 
03 FILLER PIC X(5). 
FD INFILE 


RECORD CONTAINS 256 CHARACTERS 
BLOCK CONTAINS SO RECORDS 
DATA RECORD IS SHORTEMR. 

Ol SHORTEMR. 


03 SSN PIC X(9). 
03 SCIND PIC X(5). 
03 STR-GAIN PIC 9(4). 
03 STR-LOSS PIC 9(4). 
03 DATE-OF-BIRTH PIC 9(6). 
03 SEX PIC X. 
03 RACE PC Ss 
03 ETHNIC SIC &. 
O03 HOME-OF-RECORD PIC xx 
O03 PDEPS PIc x 
O03 PRESENT-RATE. 
OS PRATE-CODE PIC 9(4). 
O05 PAYGRADE PIC Q. 
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03 


03 


TIME-IN-RATE. 


O05 TIME-IN-RATE-YY 
O05 TIME-IN-RATE-MM 
EFF-DATE-PAYGRADE. 


OS EFF-DATE-YY 

O05 EFF-DATE-MM 
PNEC. 

OS PNEC-CODE 

OS PNEC-DATE 


O05 SNEC-CODE 
05 SNEC-DATE 
CURRENT-PRO-PAY. 
O05 PRO-SKILL 
O05 PRO-LEVEL 
05 PRO-AUTH 
VRB 
RQC 
SOFT-EAOS. 
05 SOFT-YY 
OS SOFT-MM 
BRANCH-CLASS 
ADSD 
CADD. 
05 CADD-YY 
05 CADD-MM 
CED. 
OS CED-YY 
05 CED-MM 
PEBD. 
OS PEBD-YY 
05 PEBD-MM 


PIC 99. 
PIC 99. 


eeL ey We Le ee gl lenges \s) fal Buse ee He) or eters: ose ler se, co Hes wien ee wite so ene se. eine tein <0 6 


Ce 


03 


03 
03 


03 


HARD-~-EAOS. 

O05 HARD-YY 

O05 HARD-MM 
EXTENSIONS. 

O05 SCHL-EXT 

O05 OTHER-EXT 

OS OPEX 
ENLISTMENTS. 

OS ENL-TYP 

O05 ENL-TERM 

O05 ENL-NUMBER 
TAR-SCORES-STAR 
EDUCATION. 

05 ED-YRS 

O05 ED-CERT 


ONBOARD-ACTIVITY. 


05 ACTUAL-UIC 
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R RAR 


Ho HOO 
= MO. Ss ve 


a) 
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or 
VY 


« §5 char 


99 char. 


> 


> 


er. S S42 8. gy, A ee i 


ee 2 Ea RIES a 6 eS | NE ER ee es Se) a met) ee Some, ee 


OS SEA-SHORE-CODE PIC X. 
O05 AcTY-10DIGIT PIC XC10); 


05 ACC PIC XXX. 
O5 DATE-RECD. 
O? RECD-YY PIC 99. 
, O? RECD-MM PIC 99. 
O05 PRD-DATE PIC 9(4). 
O5 PRD-REASON PIC X(4). 
05 DNEC1 PIC X(4). 
z a ee ic PM ag ake eee Tat tr ree fe We RSE ACTe CRS tae fore to are ec Mat ae in eee « 152 char > 
° O05 DNEC2 PIC X(4). 
03 PAST-ACTIVITY. 
O05 P-ACTUAL-UIC PIC X(5). 


OS P-SEA~-SHORE-CODE PIC &. 
OS P-ACTY-10DIGIT PIC Z(10). 


OS P-RATE-CODE PIC 9(4). 
OS P-PAYGRADE PIC 9. 
OS P-ACC PIC XXX. 
OS P-DATE-RECD. 
O07 P-RECD-YY PIC 99. 
O07 P-RECD-MM PIC 99. 


O05 P-DATE-TRANS. 
O07 P-TRANS-YY PIC 99. 
O07 P-TRANS-MM PIC 99. 


03 NAVY-LOSS-CODE PIC X(3). 
03 DOD-LOSS-CODE PIC X(3). 
03 DOD-AFEES PIC X(3). 
03 CURRENT-EVAL. 
OS OVERALL PIC X. 
Le ea SR. Mee ay BBE WANEs Agee aN RS Gy Rd RS ag ideal ea fe « 198 char > 
03 SCHOOL-HISTORY. 
O05 COMPLETION-DATE-1 PIC 9(4). 
05 COURSE-CODE-1 PIC X(4). 
05 STUD-ACTION-1 PIC XX. 
O05 COMPLETION-DATE-2 PIC 9(4). 
O05 COURSE-CODE-2 PIC X(4). 
OS STUD-ACTION-2 PIC XX. 
OS COMPLETION-DATE-3 PIC 9(4). 
OS COURSE-CODE-3 PIC X(4). 
05 STUD-ACTION-3 PIC XX. 
03 TYPE-ACQUISITION PIC 99. 
Moe Bi We Biz BACAR So ee CU en RRMEE Dee eh a tn Ae Lied! Moe at eh eos « 230 char > 
03 SPECIAL-PROGRAM-CODES. 
O05 SPC-CODE PIC X. 
O05 PROGENLFOR PIC X. 
OS SPC-REST PIC Xxx. 
3 RC-BRCL-FROM PIC XX. 
03 SPEC-PROG-IND-1 PIC X. 
03 SPEC-PROG-YR PIC X. 
‘ 03 SPEC-PROG-TAR PIC X. 
. 03 AFQT PIC 99. 
03 MG PIC 9. 
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O03 SRB-ZONE-DATA. 


05 ZONE-ID PIC X. 
O05 SRB-EFF-DATE PIC 9(4). 
O05 SRB-RT-SKILL-NEC PIC X(4). 
O5 SRB-PAY-CAT PIC X. 
O05 SRB-FY-PAY PIC X. : 
OS SRB-SKILL PIC X. f 
O05 SRB-LEVEL PIC X. 
RO A ee ree ane) Re eR Au Ao rat Uae ie up Sule teh cee kr ree « 256 char. > 
FD OUTFILE. 
O01 OUTREC. 
OS FILLER PIC X(126). 
FD LISTING. 
Ol PRINTLINE PIC X(132). 
WORKING-STORAGE SECTION. 
O01 INPARITY-FLAG PIC 9 VALUE O. 
Ol OUTPARITY-FLAG PIC 9 VALUE O. 
Ol ERROR-FLAG PIC 9 VALUE O. 
01 NO-WRITE PIC 9 VALUE O. 
Ol NO-LABEL PIC 9 VALUE O. 
Ol FOUND PIC 9 VALUE O. 
Ol END-OF-FILE PIC 9. 
88 EOF VALUE 1. 
01 END-OF-LABEL PTS 9. 
88 EOL VALUE 1. 
* 
O01 COUNTERS USAGE IS COMP. 
03 RECIN PIC 9(7). 
03 OUT-COUNT PIC 9(7). 
03 OTHER-COUNT PIC 9(7). 
03 TARGET-COUNT PIC 9(7). 
03 BAD-LOS PIC 9(7). 
03 BAD-RATING PIC 9(7). 
03 BAD-PAYGRADE PIC 9(7). 
03 BAD-~PROGRAM PIC 9(7). 
03 SPC-4yY0 PIC 9(7). 
03 SPC-6YO PIC 9(7). 
03 SPC-AM PIC 9(7). 
03 SPC-PS PIC 9(7). 
03 SPC-TAR PIC 9(7). 
03 SUBFARER PIC 9(7). 
03 RATING-5YO PIC 9(7). 
03 XTRA-4YO PIC 9(7). 
03 BLANK-TAR PIG.-9¢7):. 
03 BLANK-~AM PIC 9(7). 
03 OBLIG-4yYO PIC 9(7). : 
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4-digit 


O03 OBLIG-6YO 


PIE 907). 


03 PROGRAM-6 PIC 9C7). 
03 PROGRAM-7 PLE 907). 
03 SAVED-SEARCH PIC OC). 
03 NO-WRITE-LOS PIC 9(7). 
03 NO-WRITE-PG PIC. OCT). 
03 NO-WRITE-RATING PIC 9(7). 


RRR RRR EKER RRR EKER KERR 


Rating Table Version 860707 


This is a COBOL table storing all enlisted ratings in the Navy. 
It is designed to provide an easy method of associating each 
"RATE-CODE' with its equivalent alphabetic 
"RATE~ABBREVIATION'. 


o FC's (Fire Cortrolman) added 
o WT'’s (Weapons Technician) added 


KEKE REE RRR KER RRR EEK RE REEKRER 


01 


VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 


VALUE 


RATE-TABLE. 
O03 RATE-LIST. 
O05 FILLER 


PIC X(49) 


"7B800AA 67O0AB 6704ABE6705ABFE6706ABHE600AC 6200AD ". 


05 FILLER 


PIC X(49) 


“62Z06ADJ62Z05ADR6800AE 6O080AF 7100AG 7300AK 6900AM ". 


O05 FILLER 


PIC X(49) 


“69O03AME6902ZAMH6E901AMS7800AN 6500A0 6520AQ 7800AR ". 


05 FILLER 


PIC X(49) 


“7500AS T5SO1LASE7S5SO02ASH7S503ASM6300AT 6180AV 6400AW ". 


05 FILLER 


PIC X(49) 


“6310AX 7400AZ O100BM 4020BR 4000BT S600BU 6000CA ". 


05 FILLER 


PIC X(49) 


“S300CE 5500CM 6000CN 6000CR 1622CTA1G666CTI1633CTM". 


OS FILLER 


PIC X(49) 


“1644CTO1655CTRIG11CTTSO80CU 8300DA 2100DK 3200DM ". 


OS FILLER 


PIC X(49) 


“@300DN 1900DP 83OODR 1010DS 8300DT 5100EA 4100EM " 


OS FILLER 


PIC X(49) 


“S800EN S410EO S380EQ 1LOOOET 1OO1LETNIOOZETROSSOEW " 


OS FILLER 


PIC X(49) 


"SOQOOFA OVOOFC SOOOFN SOOOFR O800FT O803FTBO801FTG". 


O05 FILLER 


PIC X(49) 


"“Q802FTMOG00GM O604GMGO601GMMO602GMT4400GS 4401GSE". 


OS FILLER 


PIC X(49) 


“4402GSM8000HA 8000HM S8O000HN 8000HR 4300HT 4200IC " 


O05 FILLER 


PIC X(49) 


“11OOIM 2300IS 260030 S100LI 17S50LN O150MA 4700ML ". 


O05 FILLER 


PIC X(49) 


“S3700MM OSOOMN S900MR 2200MS O810MT 3S00MU 1400NC " 


O05 FILLER 


PIC X(49) 


“12000M OS000S 04500T O4510TAD4520TM2700PC 7600PH ". 


en ee er Or er ee On ea es 
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O05 FILLER PIC X(49) 
VALUE "1080PI 4600PM 1800PN 7000PR O200QM 1500RM 2500RP “. 
O05 FILLER PIC X(49) 
VALUE "3G00SA 2490SH 2000SK 0250SM 3600SN 3600SR O400ST ". 
05 FILLER PIC X(49) 
VALUE "O401STGO404STSS5700SW 7200TD OSOOTM OSCOTMSOSOOTMT". 
O05 FILLER PIC X(28) ‘ 


VALUE “S8OQUT O610WT 1700YN ". 


O03 RATE-EACH REDEFINES RATE-LIST. 
0S RATE-CODE-AND-ABBREV OCCURS 129 TIMES 
ASCENDING KEY IS RATE-ABBREV 
INDEXED BY R-INDEX. 
O07 RATE-CODE PIC 9(4). 
O07 RATE-ABBREV PIC XXX. 


O01 TARGET-TABLE USAGE IS COMP. 
02 PROGRAM-LEVEL OCCURS 7 TIMES. 
O03 RT-LEVEL OCCURS 129 TIMES. 
OS PG-LEVEL OCCURS 9 TIMES. 
O07 LOS-LEVEL OCCURS 21 TIMES. 


09 ENTRY PIC 9(7). 
* 
Ol RATING-HOLD. 
03 PRATE-HOLD PIC 9(4). 
88 RT-5 VALUE 2600 7600 6600 1900 5100 5600 8300 
5300 5700 5410 5500 5800 6000. 
03 PREVIOUS-RATE-CODE PIC 9(4). 
O01 TYPE-ACQUISITION-HOLD. 
03 TYP-ACQ-HOLD PIC 99. 
88 ROMEO VALUE 21 THRU 25 45 46 47. 
88 USNR VALUE 18 48. 


88 TAR-TYPE VALUE 19. 
01 SPECIAL-PROGRAM-HOLD. 
02 TAR-HOLD PIC X. 
88 TAR-PROGRAM VALUE "V". 
O01 PROGRAM-HOLD. 


02 PROG-ENL-TYPE PIC &. 
O02 PROG-ENL-~FOR. 
O03 PEF PIC X. 
88 FOUR-YO VALUE "“H" "4" “F" "K" “E 
88 AM VALUE "M" "Z" "WW". 
88 SsIx-yYO VALUE "G" "5" "A" "B". 
88 PRIOR-SERV VALUE "S" "8" "7" "N" "gr "Lh" 
88 OTHER-TYPE VALU ee VO Ce otek ys SSD 
88 BLANKZ VALUE " ". 
88 TARS VALUE "Y". 
88 PSI VALUE "J". 
O03 PEF-REST. 
OS PEF1 PIC Xx. 
O05 PEF1-REST. 
O? PEF2 PIC X. 


O7 PEF2-REST PIC X. 
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Ol SCIND-HOLD. 


03 SCl PIC Ree. 
ts SCIND code begins with this or they're a LOSS 
88 GAIN VALUE "XF". 
03 FILLER PIC XxX. 
4 Ql BR-CL-AREA. 
. 03 BRCL-HusLD PIC XX. 


88 USN VALUE "11". 
O1 ACTY~HOLD. 


. 03 ACTY-TYPE PIC 9(4). 
3 03 HULL-NUMBER PIC 9(4). 
038 FILLER PIC XX. 
O01 WORK-AREA. 
03 ADSD-MONTHS PIC 9(6). 
03 NOW-MONTHS PIC 9(6). 
03  ADSD-HOLD. 
OS ADSD-Y PIC 99. 
O05 ADSD-M PIC 99. 
05 ADSD-D PIC 99. 
03 SEAOS-MONTHS PIC S9(6). 
03 SEAOS-HOLD. 
05 SEAOS-Y PIC 99. 
0S SEAOS-M PIC 99. 
03 CED-MONTHS PIC s9(6). 
03 CED-HOLD. 
O05 CED-Y PIC 99. 
05 CED-M PIC 99. 
03 OBLIG PIC s9(6). 
Ol EMR-DATE. 
03 EMR-YR PIC 99. 
03 EMR-MO PIC 99. 
+ this assumes the EMR is created at the end of the month... 
03 EMR-DA PIC 99 VALUE 30. 


Ol IO-WORK-AREA. 
03 IN-STATUS. 


05 INSTAT PIC 9. 

O05 INSTAT2 PIC 9. 
03 OUT-STATUS. 

05 OUTSTAT PIC 9. 

05 OUTSTAT2 PIC 9. 


Ol PAR-COUNT-TABLE USAGE IS COMP. 
03 PARCOUNTS OCCURS 10 TIMES. 

O05 INPARITY-COUNT PIC 9(7). 

0S OUTPARITY-COUNT PLC OCT): 
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Ol 


Ol 


Ol 


Ol 


Ol 


Ol 
Ol 


SUBSCRIPTS 


03 
03 
03 
03 
03 
03 
03 
03 
03 


LOS 

PG 

PM 
PREVIO 


USAGE IS COMP. 


US-R 


PROGRAM-LABELS. 
PROGRAM-LABEL-ALL. 


03 


03 


05 
@he) 
05 
05 
05 
0S 
05 


TITLE-LINE. 
05 FILLER 


0s 


TITLE- 


DETAIL-LINE. 
SLOT OCCURS 21 TIMES PIC 


OS 


REC-LINE. 


05 
05 
05 


PART-1 
PART-2 
PART-3 


M-LINE. 


05 
05 


PROSE 
M-NUM 


FILLER 
FILLER 
FILLER 
FILLER 
FILLER 
FILLER 
FILLER 


SLOT 


PIC S999. 
PIC sgg99. 
PIC 8999. 
PIC sggg. 
PIC sgg99. 
PIC sggg. 
PIC sggg. 
PIC sgg99. 
PIC S999. 


PIC X(20) VALUE “4-year Obligors 
PIC X(20) VALUE “Active Mariners 
PIC X(20) VALUE "5 & 6 year Obligors " 
PIC X(20) VALUE “Pricr Service 
PIC X(20) VALUE “TARS 
PIC X¥(20) VALUE “LOS 10 & Greater 
PIC X(20) VALUE "“Other/No Program 
PROGRAM-LABEL-EACH REDEFINES PROGRAM-LABEL-ALL. 

0&5 PLABEL OCCURS 7 TIMES PIC X(20). 


PIC X(112). 
PIC (108). 
PIC X(58). 


PARITY-REASON-LIST. 
O3 PARITY-LIST. 


PIC X(30 


PIC X(60) VALUE SPACES. 
PIC Xxx. 


222229. 


oy 


PIC 2222222229. 


05 FILLER PIC X(20) VALUE " AT END INVLD. KEY". 

OS FILLER PIC X(20) VALUE “PERM ERROR**********" 

05 FILLER PIC X(20) VALUER "*** 8 Ree RR KK 

05 FILLER PIC X(20) VALUER "“** * #8 ke RK 

05 FILLER PIC X20) VALUE "DEC ERROR ********e«" 
03 PARITY-EACH REDEFINES PARITY-LIST. 

OS PARITY-REASON OCCURS 10 TIMES PIC X(10). 


DISPLAY -WINDOW 
REC-WINDOW 


PIC Z2222Z99V99. 


PIC ----- 
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PROCEDURE DIVISION. 
RRR EKER KEKE EKER KKK 
* This program processes the SHORT EMR. 
It is set up to create and write a 4-dimensional table, 
1. Entry program (7) 
2. Rating (129) 
3. Paygrade (9) 
4. Length of Service in years (21) 


ee KKKR ERR KER ERK REKER ERE KER ERR RK KEK KKK KK 


* % *% © & 


* 


DECLARATIVES. 
BAD-INPUT SECTION. 
USE AFTER STANDARD ERROR PROCEDURE ON INFILE. 
BAD-INPUT-PARA. 
IF INSTAT > O 
ADD 1 TO INPARITY-COUNT (INSTAT) 
IF IN-STATUS >» "29" 
DISPLAY "INPUT STATUS IS “ IN-STATUS 
MOVE 1 TO INPARITY-FLAG. 
END DECLARATIVES. 


MAIN-CODING SECTION. 
LABEL- PARA. 
OPEN INPUT LABFILE. 
READ LABFILE AT END MOVE 1 TO NO-LABEL. 
MOVE LAB-YR TO EMR-YR. 
IF LAB-MO = “X" 
MOVE 03 TO EMR-MO 
ELSE IF LAB-MO = “J" 
MOVE 06 TO EMR-MO 
ELSE IF LAB-MO = "S" 
MOVE 09 TO EMR-MO 
ELSE IF LAB-MO = "D" 
MOVE 12 TO EMR-MO 
ELSE MOVE "999999" TO EMR-DATE 
MOVE 1 TO NO-LABEL. 
DISPLAY "EMR LABEL IS " EMR-DATE. 
CLOSE LABFILE. 


COMPUTE NOW-MONTHS = (EMR-YR * 12) + EMR-MO. 
INITIAL-PARA. 
OPEN INPUT INFILE, 
OUTPUT OUTFILE, LISTING. 
INITIALIZE COUNTERS, PAR-COUNT-TABLE. 


* Echo the date read in as the “current” date... 


DISPLAY “ NOW set for ", LAB-MO," 19",LAB-YR," for LOS purposes..." 


MOVE O TO END-OF-FILE. 
READ INFILE AT END MOVE 1 TO END-OF- PILE. 
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PERFORM READ-WRITE-CYCLE 
UNTIL EOF. 
PERFORM PROGRAM-TABLE-DUMP VARYING PM FROM 1 BY 1 
UNTIL PM > 7. 
SECOND-PARA. 
PERFORM STATS-ROUTINE. 
FINISH-UP. 
CLOSE LISTING. 
CLOSE OUTFILE. 
CLOSE INFILE. 
STOP RUN. 
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READ-WRITE-CYCLE. 


’ MOVE SCIND TO SCIND-HOLD. 
* limit this to only Active Strength Gains 
IF GAIN 
. ADD 1 TO TARGET-COUNT 
. PERFORM REST-OF-PROGRAM. 


READ INFILE AT END MOVE 1 TO END-OF-FILE. 
ADD 1 TO RECIN. 


REST-OF- PROGRAM. 
MOVE O TO NO-WRITE. 
** LOS (length of service) IN MONTHS 
IF ADSD IS NUMERIC AND (ADSD >» "000000" ) 
PERFORM LOS~COMPUTE 
ELSE 
ADD 1 TO NO-WRITE-LOS 
MOVE 1 TO NO-WRITE. 
IF NO-WRITE = 0 
IF LOS > 9 
ADD 1 TO PROGRAM-6 
MOVE 6 TO PM 
IF LOS » 20 
MOVE 21 TO LOS 
PERFORM CONTINUE-WITH-PAYGRADE 
ELSE 
PERFORM CONTINUE-WITH-PAYGRADE 
ELSE 
PERFORM DETERMINE-~PROGRAM 
PERFORM CONTINUE-WITH-PAYGRADE. 


DETERMINE-PROGRAM. 
eK RRR EEK KARR KKK KERR Ke KK KK 
* SPECIAL-PROGRAM field on the EMR is used to determine program 
* of entry. If this information is missing or inconclusive, the 
* procedures MEASURE-THE-OBLIGATION and CHECK-BLANKS-FOR-PROGRAM 
* attempt to use other means to determine program of entry. 
eK KEE KKK KR REE KRERe KR R KK  K 
MOVE SPECIAL-PROGRAM-CCDES TO PROGRAM-HOLD. 
MOVE PRATE-CODE TO PRATE-HOLD. 
MOVE SPEC-PROG-TAR TO TAR-HOLD. 
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ELSE 


ELSE 


ELSE 


ELSE 


ELSE 


ELSE 


ELSE 
ELSE 


IF 


13 


IF 


IF 


IF 


IF 


IF 


ER 


TARS 
OR TAR-PROGRAM 
ADD 1 TO SPC-TAR 
MOVE 5S TO PM 
FOUR-YO 
ADD 1 TO SPC-4YO 
MOVE 1 TO PM 
AM 
IF PEF1 = "4" 
ADD 1 TO SUBFARER 
MOVE 1 TO PM 
ELSE 
ADD 1 TO SPC-AM 
MOVE 2 TO PM 
SIX-YO 
ADD 1 TO SPC-6YO 
MOVE 3 TO PM 
PRIOR-SERV 
ADD 1 TO SPC-PS 
MOVE 4 TO PM 
RT-5 
ADD 1 TO RATING-SYO 
MOVE 3 TO PM 
PSI OR OTHER-TYPE 
IF ENL-NUMBER = 1 
PERFORM MEASURE-THE-OBLIGATION 
ELSE 
MOVE 1 TO PM 
ADD 1 TO XTRA-4Y0 
BLANKZ 
PERFORM CHECK-BLANKS-FOR- PROGRAM 
ADD 1 TO PROGRAM-7 
MOVE 7 TO PM. 


CHECK-BLANKS-FOR- PROGRAM. 


* use TYPE-OF_ACQUISITION to determine program of entry... 


MOVE TYPE-ACQUISITION TO TYP-ACQ-HOLD. 
IF TAR-TYPE 


ELSE 


ELSE 


ELSE 


i a a ee or ee A ee ee a ee ee ie ee el Jee, ee Oe ee, Ve et ie en ee es ee ae on en ee oer eee | 


IF 


IF 


ADD 1 TO BLANK-TAR 

MOVE 5S TO PM 

USNR 

ADD 1 TO BLANK-AM 

MOVE 2 TO PM 

ENL-NUMBER = 1 

PERFORM MEASURE-THE-OBLIGATION 
ADD 1 TO PROGRAM-7 

MOVE 7 TO PM. 
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MEASURE-THE-OBLIGATION. 


REREKRHE KERR AR RK KKRKREKRER ERK RR KEEREKR RH REE ERE KEKE KEKE KERR K KKK KE 


* Use current obligation (lst termers only) to determine program of entry... 


* Those with 4 year obligations go to 4YO program, those with greater 
* go to the 5/6Y0O progran... 


KR EKER EERE ERR KEKE RE KEK KKK 


MOVE SOFT-EAOS TO SEAOS-HOLD. 
MOVE CED TO CED-HOLD. 
: COMPUTE CED-MONTHS ROUNDED = CED-M + (CED-Y * 12). 
: COMPUTE SEAOS-MONTHS ROUNDED = SEAOS-M + (SEAOS-Y * 12). 


SUBTRACT CED-MONTHS FROM SEAOS-MONTHS GIVING OBLIG ROUNDED. 


IF OBLIG » 48 
ADD 1 TO OBLIG-6YO 
MOVE 3 TO PM 

ELSE 
ADD 1 TO OBLIG-4YO 
MOVE 1 TO PM. 


CONTINUE-WITH-PAYGRADE. 
IF PAYGRADE IS NUMERIC 
MOVE PAYGRADE TO PG 
IF PG > O AND (PG « 10) 
PERFORM CONTINUE-WITH-RATING 
ELSE 
ADD 1 TO NO-WRITE-PG 
MOVE 1 TO NO-WRITE 
ELSE ADD 1 TO NO-WRITE-PG 
MOVE 1 TO NO-WRITE. 


CONTINUE-WITH-RATING. 


IF PRATE-CODE = PREVIOUS-RATE-CODE 
ADD 1 TO SAVED-SEARCH 
MOVE PREVIOUS-R TO R 
MOVE 1 TO FOUND 
ELSE 
MOVE O TO FOUND 
PERFORM TABLE-SEARCH VARYING I FROM 1 BY 1 
UNTIL FOUND = 1 OR (1 > 129). 
IF FOUND = 0 
ADD 1 TO NO-WRITE-RATING 
MOVE 1 TO NO-WRITE 
ELSE 


IF NO-WRITE = 0 
s ADD 1 TO ENTRY (PM,R,PG,LOS). 


REE EERE RR END OF REST-OF-PROGRAM eR KK KE 


B-113 


Pet mel eh 2 ee oe oe ee Oe Pe Or we bl eee eee ee ere 2ee Lae ae ie ie Bo lee ie oe ee So eo ee ee See ee Ser ar i a oa Oa 


TABLE-SEARCH. 
IF RATE-CODE (I) = PRATE-CODE 
MOVE PRATE-CODE TO PREVIOUS-RATE-CODE 
MOVE I TO R, PREVIOUS-R 
MOVE 1 TO FOUND. 


LOS-COMPUTE. 
MOVE ADSD TO ADSD-HOLD. 
COMPUTE ADSD-MONTHS = (ADSD-Y * 12) + ADSD-M. 


COMPUTE L = NOW-MONTHS - (ADSD-MONTHS). 
COMPUTE LOS =<(L: 7 12) * 1. 


PROGRAM-TABLE-DUMP. 
PERFORM RATE-TABLE-DUMP VARYING R FROM 1 BY 1 
UNTIL R > 129. 
RATE-TABLE-DUMP. 
PERFORM PAYGRADE-TABLE-DUMP VARYING PG FROM 1 BY 1 
UNTIL PG > 9g. 
PAYGRADE-TABLE-DUMP. 
PERFORM LOS-DUMP VARYING LOS FROM 1 BY 1 
UNTIL LOS > 21. 
WRITE OUTREC FROM DETAIL-LINE AFTER 1 LINE. 


LOS-DUMP. 

MOVE ENTRY (PM,R,PG,LOS) TO SLOT (LOS). 
WRITE-LINE. 

MOVE SHORTEMR TO REC-LINE. 


WRITE PRINTLINE FROM PART-1 AFTER ADVANCING 3 LINES. 


WRITE PRINTLINE FROM PART-2 AFTER ADVANCING 1 LINE. 
WRITE PRINTLINE FROM PART-3 AFTER ADVANCING 1 LINE. 
MOVE SPACES TO PRINTLINE. 
WRITE PRINTLINE AFTER ADVANCING 1 LINE. 
* 
STATS-ROUTINE. 
MOVE “INPUT RECS "“ TO PROSE. 
MOVE RECIN TO M-NUM. 
WRITE PRINTLINE FROM M-LINE AFTER 2 LINES. 
MOVE “PARITY ERRORS" TO PRINTLINE. 
WRITE PRINTLINE AFTER 2 LINES. 
PERFORM PARITY-INFO-DUMP VARYING I FROM 1 BY 1 
UNTIL I> Q. 
MOVE "NO. OF ACTIVE" TO PROSE. 
MOVE TARGET-COUNT TO M-NUM. 
WRITE PRINTLINE FROM M-LINE AFTER 2 LINES. 


MOVE "No. of Saved Rate Searches" TO PROSE. 


MOVE SAVED-SEARCH TO M-NUM. 
WRITE PRINTLINE FROM M-LINE AFTER 2 LINES. 
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MOVE "OUTPUT RECORDS" TO PROSE. 
MOVE OUT-COUNT TO M-NUM. 
WRITE PRINTLINE FROM M-LINE AFTER 2 LINES. 


. MOVE "Program Enlisted For 4¢ YO" TO PROSE. 
: MOVE SPC-4YO TO M-NUM. 
WRITE PRINTLINE FROM M-LINE AFTER 3 LINES. 


MOVE 6 YO" TO PROSE. 
2 MOVE SPC-6YO TO M-NUM. 
"i WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE “ A.M." TO PROSE. 


MOVE SPC-AM TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE "“ P.S." TO PROSE. 
MOVE SPC-PS TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE " TAR " TO PROSE. 
MOVE SPC-TAR TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE " 4 YO Subfarer " TO PROSE. 
MOVE SUBFARER TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE "“ 5 YO Rating " TO PROSE. 
MOVE RATING-S5YO TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE "“ PSI or Other 4 YO "TO PROSE. 
MOVE XTRA-4YO TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE “TAR by TYPE-ACQUISITION "TO PROSE. 
MOVE BLANK-TAR TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE “AM by TYPE-ACQUISITION " TO PROSE. 
MOVE BLANK-AM TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE “Obligation 4 YO "TO PROSE. 
MOVE OBLIG-4YO TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE "Obligation 6 YO “TO PROSE. 
MOVE OBLIG-6YO TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE "LOS Greater than 9 “ TO PROSE. 
MOVE PROGRAM-6 TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE "Unknown Program (7) “ TO PROSE. 
MOVE PROGRAM-7 TO M-NUM. 

WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 


MOVE "Not Written LOS "TO PROSE. 
MOVE NO-WRITE-LOS TO M-NUM. 
e WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE “Not Written Paygrade "TO PROSE. 
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MOVE NO-WRITE-PG TO M-NUM. 
WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
MOVE “Not Written Rating " TO PROSE. 
MOVE NO-WRITE-RATING TO M-NUM. 
WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 
PARITY-INFO-DUMP. 
IF INPARITY-COUNT (I) » O OR (OUTPARITY-COUNT (I) > 0) ‘ 
MOVE PARITY-REASON (I) TO PROSE 
MOVE INPARITY-COUNT (I) TO M-NUM 
WRITE PRINTLINE FROM M-LINE AFTER 1 LINE 
MOVE " OUTPUT" TO PROSE 
MOVE OUTPARITY-COUNT (I) TO M-NUM 
WRITE PRINTLINE FROM M-LINE AFTER 1 LINE. 


TE ToS 
MOVE 8 TO I. 


* 


PREMATURE-ABORT. 
MOVE "<<« EXCESSIVE PARITY ERRORS ENCOUNTERED >>>" 


TO PRINTLINE. 
WRITE PRINTLINE AFTER 5 LINES. 
MOVE "<«<« RUN IS TERMINATING PREMATURELY >>>" TO 


PRINTLINE. 
WRITE PRINTLINE AFTER 2 LINES. 
GO TO SECOND-PARA. 
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ANNEX B-2 
APL PROGRAM LISTINGS FOR COMPUTING 
AGGREGATE TRANSITION AND ADDITION RATES 
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APL PROGRAM LISTINGS 
FOR COMPUTING TRANSITION 
AND ADDITION RATES 


FUNCTION: XTRANS_TO 


. VI<YEAR1 XTRANS_TO YEAR2 
e THIS FUNCTION CONSTRUCTS THE TRANSITION RATES FROM 
YEAR1 TO YEAR2. 


D> 


INVENTORIES ARE DIVIDED INTO 5S ENTRY PROGRAMS 
ONLY FOR LOS 1 TO LOS 9. THEREFORE, TRANSITION RATES 
ARE COMPUTED SEPARATELY FOR THESE 2 PARTS. 
INVENTORIES OF LOS 1-9 ARE STORED IN “YMAT1” AND YMAT2™. 
RIGHER LOS PARTS ARE STORED IN “SENIOR™, “SENIOR1™ 
“SENIOR2°... 


Ae 


2 anon Neuen Ts 


Ie 


DO vDBDIBDDIDIPID DDD 


1] 

2] 

3] 

4] 

5] 

6] 

7] 

8] 

9] 

[10] 

‘can FILE 17 = TRE FULL EMR INVENTORY 

[12] 19 = REDUCED (5 X¥ 69 X¥ 9 X 9) INVENTORY (LOS1 IS Y-1) 
(13] 13 = NEW FY PRIOR SERVICE ACCESSIONS 

[14] 8 = INVENTORY OF HIGH LOS (21-31) (SEPARATE FOR 
[15] STORAGE REASONS ) 
(16] ry 

{17] (das QC#ANS 

[18] CF+Q]ASS '17 CNAQ: [GARVEYK.APL] SEPTEMBER/DA' a OPEN 17 
(19] a . 

[20] CF+[JASS '19 CNAQ: [GARVEYK.APL] SEPT/DA' a OPEN 19 
[21] YMAT1++/ [3] § (88-Y1] 19 

[22] YMAT2++/ [3] 4 [88-yY2] 19 

{23] QDAS 19 

(24] a 

[25] a PRIOR SERVICE 


[26] oo FORM “NEWPS” WHICH IS THE NEW PRIOR SERVICE ACCESSIONS 
[27] « IN THE END YEAR, SUBTRACT IT FROM THE END YEAR INVENTORY... 
[28] CF+JASS '13 CNAQ: [GARVEYK.APL] PRIORSERVICE/DA' 

[29] PRIOR_END++/ (2] 4 [88-Y2] 13 

[30] PS+YMAT2 [4;;] 

[31] NEWPS*+CONDENSE 129 9+PRIOR_END 

{32] LESS_THAN+((,PS)<,NEWPS)/19,PS 

(33] +(O=pLESS_THAN)/L1 

[34] ' NEW BLOOD CELL EXCEEDS PRIOR SERVICE CELL. ' 

(35) MNEWPS+,NEWPS 

(36) MNEWPS [LESS_THAN] +( ,PS) [LESS_THAN] 

(371 MNEWPS+(MSHAPE,9)pNEWPS 


(38) Li: 

(39] a REMOVE END-YEAR NEW PRIOR SERVICE ACCESSIONS FROM NUMERATOR 
‘ [40] YMAT2 [4;;] —PS - NEWPS 
y [41] ao 
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50] a ARE IN FILE 8... 

51) CF+{JASS '8 CNAQ: [GARVEYK.APL] HIGHLOS/DA' a OPEN 8 
[52] HIGHi++/ [2] § (88-Y1]8 

(53) HIGH2++/ [2] 8 (88-yY2]}8 

{(54] DAS 8 

[55] a 

[56] «© “SENIOR” IS THE FULL BEGIN-YEAR INVENTORY.. 

(57) « “SENIOR1” IS THE INVENTORY LOS 10-21 (THE PART OF 
[58] a THE INVENTORY NOT DIVIDED INTO ENTRY PROGRAMS). 
[59] SENIOR1+1 129 ~12+5 0 O+SENIOR++/ [3] 4 (88-Y1] 17 

[60]  LOSQO+CONDENSE ++SENIOR {;;9] 


ORR ae epeg ne cee ic ee RIN Sad eh A ct cat eR Ey Mee Aig MNES a Gils 2) RAT Oe OR leg ear ae acnOi 
(43] eo “LOS1_T° IS THE TOTAL (BY PROGKAM) OF LOS 1. 

[44] a IT WILL BE RE-SHAPED AND USED AS DENOMINATOR FOR 

[45] a FOR THE LOS 1 DIMENSION OF THE ADDITION MATRIX... 

[46] LOS1_T+T_ALLOCATION (88-Y1) 

(47] ire eens Fe Sha A tell Ae ap tO rc DREN TENS SAE DY nD Oa Re eg te ode Ne Rite ee 
[48] A 

(49] ® FOR STORAGE REASONS, THE UPPER LOS INVENTORY (LOS 21-31) 

[ 

[ 


[61] SENIOR1<(+#41 129 11+SENIOR1), [2] FIGH1 

[62] SENIOR1*CONDENSE SENIOR} 

(63] SENIOR1+(((pLOS9),1)pLOS9), [2] SENIOR1 

[64] a. “SENIOR1° +IS NOW LOS 9 - 31... 

[65] SENIOR2+1 129 ~12+5 0 O++/ [3] 4 [88-Y2] 17 

[66] a 

(67] «a PRIOR SERVICE 

[68] a (SAME PROCEDURE THAT WAS PERFORMED ON LOWER LOS, NOW DONE 
{69] a ON THE HIGHER LOS END-YEAR INVENTORY...) 


[70] LESS_THAN«(( ,SENIOR2)<,NEWPS)/19,NEWPS 

[71] +(O=pLESS_THAN)/L2 

(72] ' NEW BLOOD CELL EXCEEDS PRIOR SERVICE CELL. ' 
[73] NEWPS+,NEWPS 

[74] NEWPS (LESS_THAN} +( ,SENIOR2) [LESS_THAN] 


(75) La: 

[76] NEWPS+1 129 12pNEWPS 

[77] SENIOR2+SENIOR2 - NEWPS e REMOVE PRIOR SERVICE 
[78] (DAS 17 

(79] A 


{80] © “TRANS_DIVIDE_BY” DIVIDES END-YEAR INVENTORY BY BEGIN-YEAR, 
[81] 4 AND RETURNS A RESULT THAT CONTAINS BOTH THE TRANSITION 

} 4 AND ADDITION MATRIX. THE ADDITION MATRIX IS THE MATRIX 
{83] 9 OF EVERY CELL WHERE END-YEAR INVENTORY EXCEEDS BEGIN-YEAR. 

] 

} 


(84 SENIOR2+(+741 129 11+SENIOR2), (2) HIGH2 

(85 SENIOR2+CONDENSE SENIOR2 

{86] T1+SENIOR2 TRANS_DIVIDE_BY (0 ~1+SENIOR1) 

(87) T2+T1 (2; ;] 9 “T2° IS THE ADDITION MATRIX (HIGH LOS) 
(ss) Tayert tty 3) a “T1° IS THE TRANSITION MATRIX (HIGH LOS) 
{89} 9 


[90] YMAT1+(5,MSHAPE,7)+((5,MSHAPE,1)+YMAT1), (3]0 0 2sYMATI 
[91] YMAT2+(5,MSHAPE,7)+ 26 YMAT2 
(92] om “YMAT1” BECOMES LOS 1 3 4 


5 6 
[93] 9 “YMAT2” BECOMES LOS 34567 


7 8 
8 9 
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4] 
5] « “TRANS_DIVIDE_BY IS AGAIN USED TO GET TRANSITION/ADDITION 
6] a MATRICES FOR THE LOWER (1-9) LOS CELLS... 

7] Az Bzwuaweetzw ew eT SR Sess se sSeB ee ses eee SBS BSB SBSBAAST Sw Bear eezwzzeatwessz22== =e t= 
98] 13+YMAT2 TRANS_DIVIDE_BY YMAT1 

99] T4+73[2;;:] 


(100) 73+(73[1;;;] ), [3] (S,MSHAPE,22) p71 ® COMBINE LOW/HIGH TRANSITION 
(101] 74+74, [3] (5,MSHAPE,22)pT2 a LOW/RIGH ADDITION 

* {102] «a 
[103] SENIOR+6 129++/SENIOR a SENIOR (THE BEGIN YEAR INVENTORY )} 
[104] SENIOR+CONDENSE SENIOR a IS SUMMED ACROSS PROG, PG AND LOS 
[105] SENIOR++#SENIOR 
[106] SENIOR+&8(5,MSHAPE)0540p,SENIOR 
(107] SENIOR+&8(28,MSHAPE,S)0SENIOR oo BEING PREPARED AS THE DENOMINATOR 
[108] DENOM+LOS1_7, [3] SENIOR a TO COMPUTE THE “ADDITION PERCENTS.. 
[109] 72-73, [1] 74+74 ZERO_DIVIDE_BY DENOM 
{110] a 


(111] a NEW RATINGS FC AND WI HAVE NO TRANSITION HISTORY... 
{112] a WE ARE SUBSTITUTING THE RATING WHERE THEY CAME FROM... 
(113] FC+MSHAPE A_TO_N UECe 

[114] FIG*+MSHAPE A_TO_N '‘FIG' 

[115] +(O=pFC)/NO_FC 


[116] 72 (5+15:FC;}] +0 a ADDERS FOR THE NEW RATINGS SUPPRESSED... 
(117] 72 (15:FC;) +72 (15:F7G;] «© FC IS GIVEN THE SAME TRANSITION AS FTG 
[118] NO_FC: 

[119] WI+MSHAPE A_TO_N ‘Wr ' 

[120] +(O=pWT)/NO_WI 

[121] GMT+MSHAPE A_TO_N 'GM ! 

[122] 72 [5+15;:W2:] +0 e ADDERS FOR THE NEW RATINGS ARE SUPPRESSED 
[123] 72 (15:;W2;] +72 (15;:GM7:] » WI IS GIVEN THE SAME TRANSITION AS GMT 
{124] NO_W?: 

(125) ODAS OCHANS 

[126] %+T2 
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20) 
21] 


23] 


1 fo fo 
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28] 
29] 
30] 
31] 
32] 
33] 
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FUNCTION: CONDENSE 


VMOUT+CONDENSE MIN 


e THIS FUNCTION ACCEPTS A MATRIX AS INPUT THAT HAS ONE (AND ONLY 
ONE) DIMENSION EQUAL TO 129. THAT DIMENSION IS ASSUMED TO REPRESENT - 
RATING, AND IS REDUCED FROM 129 TO “MSHAPE™ (69 IN OUR APPLICATION) ~ 
BY USING THE GLOBAL VARIABLES “CRATES (INDEX OF CHIEF RATINGS), 
“FRATES” (INDEX OF “FEEDER” RATES) AND “FEED_VEC’, WHICH GUIDES HOW 
FEEDER RATINGS ARE COLLAPSED INTO CHIEF RATINGS. 


CRATES = 2 9 12 18 23 39 46 49 54 58 62 84 89 100 106 


FRATES = 3 457 8 13 14 15 12 17 19 20 21 22 25 29 31 32 45 48 53 
55 56 57 59 60 61 63 64 67 68 79 82 85 86 101 102 103 107 


FEEDVEC= 1717125 3 3 3 2 5 4 4 465 § 615 8 6 89 
S O'S 40. 10. 1G AN P18) OAs 4B 12 as 48. oe: 46 


>OROODIOPBRIrMePIDDD DD 


a 

R+(pMIN) 1 129 

SH+ppMIN 

+(R>SH)/O 

a CHECKS FOR 1 DIMENSION OF SHAPE 129... 

NEWSHAPE«pMIN 

NEWSHAPE [R] +1 

a “ZERO_LINES” ARE EITHER OBSOLETE RATINGS OR REDUNDANT ONES 
a (IE. “SR” AND “SN” ARE REDUNDANT BECAUSE “SA IS USED...) 
ZERO_LINES«8 9 18 21 32 38 39 50 52 54 61 62 66 67 80 81 82 
ZERO_LINES*+ZERO_LINES,117 118 125 126 


A 

ZERO_IN*7 7 1 1 33 35 35 47 47 47 60 60 64 64 79 79 79 113 
ZERO_IN*+ZERO_IN,113 124 124 

BOOL1+12991 

BOOL1 [ZERO_LINES] +0 

Ci+(R~1)p';! 

C2+(SH-R)p';! 

ry 

K+1 

Li: 

COMAND+'MIN [',C1,'2ERO_IN [K] ',C2,'] +MIN [' ,C1,'ZERO_IN [K] ',C2 
COMAND+COMAND,'] + MIN[',C1,'ZERO_LINES [kK] ',C2,']' 

2COMAND 

K+K+1 

~(Ks(pZERO_IN) )/L1 

r.) 

COMAND+'MIN [' ,C1,'ZERO_LINES' ,C2,'}] +0' 

2COMAND 

COMAND+'M2+MIN [' ,.C1,'(B00i1/1129)',C2,'] ' 

2COMAND 

oe PUT ADR AND ADd FROM THE 129 LIST INTO AD OF THE 108 LIST... 
AD108+ATON 'AD '! 

AD129+ATON129 'ADdADR' 


COMAND+'M2 [',C1,'AD108' ,C2,'] -M2[',C1,'AD108' ,C2,') ~ NEWSHAPEp+/ (R}] MIN | 
COMAND+COMAND,C1,'AD129' ,C2,'}' 
aCOMAND 
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[52] «a SAME FOR ETR EIN TO ET... 

[53] ET108+ATON ‘ET ' 

[54] ET129¢ATON129 'ETRETN' 

[55] COMAND+'M2 [',C1,'ET108' ,C2,"} +M2[',C1,'ET108' ,C2,'] + NEWSHAPEp+/ [R] MIN [' 
[56] COMAND+COMAND,C1,'E2129',C2,']' 

{57] *sCOMAND 


[58] d+1 

(59] TOP: 

[60] PATTERN_1+PATTERN_2+' [',((R-1)p';') 

(6 1] PATTERN_1+PATTERN_1,(¥FRATES [J] ),((SH-R)p';'),')' 

{62] PATTERN_2+PATTERN_2,( CRATES ([FEED_VEC [J] ] ),((SH-R)p':'),')! 
[63] COMAND+'M2' , PATTERN_2,'+M2' ,PATTERN_2,'+M2' , PATTERN_1 

(64] 2COMAND 

[65] a NEXT LINE DISPLAYS THE FEEDER-TO-CHIEF PROCESS... 

[66] e LISTIO8 [FRATES [J] ;5 6 7],' TO ',LIST108 [CRATES [FEED_VEC [J]! :5 6 7} 
(67) A BUT IS COMMENTED OUT.. 

{68} d+d+1 


[69] +(dspFRATES)/TOP 

[70] BOOL1+108pe1 

[71] BOOL1 [FRATES] <0 

(72] PATTERN_i~' (',((R-1)9'3'),(¥(BO0L1/1108)),((SH-R)p's'),']! 
(73) «a'MOUT+M2' , PATTERN_1 


FUNCTION: TRANS_DIVIDE_BY 


vZ + X TRANS_DIVIDE_BY Y ;2IP; SHAPE; N;NUM;DENOM ,TOO_BIG;DIFF 
[1] a THE RULE HERE [IS : 
[2] a NUM + DENOM IS CONSTRAINED TO ( < 1 ) 
[3] e THE OUTPUT OF THIS FUNCTION IS THE MATRIX OF QUOTIENTS 
(4] o OBTAINED FROM X = Y, COMBINED WITH AN IDENTICALLY-SHAPED 
[5] a “EXCESS MATRIX, WHCIH CONTAINS ZEROES EXCEPT WHERE X : Y. 
(6] a THOSE CELLS OF THE “EXCESS” MATRIX CONTAIN (X - Y). 
[7] A 


[8] SHAPE~pY 

£9} N+1«/SHAPE 

"10] DENOM+,Y 

(11] NUM+,X 

12) TOO_BIG+(NUM>DENOM)/N 

13] DIFF+(X>Y)«SHAPEQNUM-DENOM 
“14] 2IP+(NUM=0)/N 

(15) NUM (TOO_BIG] -DENOM (TOO_BIG| 
{16]  DENOM [ZIP] -1 


[17] A 

18) oo IF X IS OF SHAPE (I.¢0), THEN THE OUTPUT 2 IS SHAPE (2,I.di. 
[19] A Z(1:;] = TRANSITION MATRIX 

'20]) a Z[2::] = “EXCESS” MATRIX TO BE USED TO MAKE ADDITION MATRIX 
2:1] r) 

(22) Z-(2,SHAPE)p(SHAPEQNUM=DENOM), (1) DIFF 
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FUNCTION: T_ALLOCATION 


VMOUT + T_ALLOCATION YEAR :M;PRIOR;P; ALLOCATION : 
1] a THIS FUNCTION PROVIDES A TOTAL LOS 1 FOR “YEAR” TO THE FUNCTION : 
2] n "“XTRANS_TO™. 

3] A 

4] M+YMAT1 - 
5] +(V/(5,MSHAPE ,9)=9M)/0 

6] ALLOCATION++/M [:; 1] 

7) 

8] 

9] 


a 


QA eee eet asze2ee sass sess Mest eeBEeet Bee esses aAsI RST EBT ses tA aA RFassS sss SE eS s= 


a THE FOLLOWING IF “NEW-BLOOD PRIOR SERVICE ARE TO BE INCLUDED 
{10} «4 AS LOS1 PRIOR SERVICE IN THE ALLOCATION MATRIX... 


[11] QO ===2=z Pee ee eee ee eee ee Se ee ee ee ee ee ee ee eee eee eee ee ee eee 


{12] A 

[13] PRIOR++/ (2) 4 [( YEAR+1)] 13 
[14] +(V/(129 21)*pPRIOR)/O 
[15] P++/PRIOR+CONDENSE PRIOR 
[16] ALLOCATION [4] <+/P 


[18] MOUT<++/ALLOCATION 


™, 


Las 


FUNCTION: A_TO_N 


YN + SIZE A_TO_N RATING i:SH:A 
(1] 9 THIS FUNCTION IS A GENERAL PURPOSE METHOD OF PRODUCING INDECES 


21] RATING+3sRATING 
22] +(( pRATING)>0O)/TOP 
23] XIT: N+SH 


(2] oe INTO A LIST OF RATINGS, USING THE RATING ABBREVIATION 

(3] a 

[4] e GIVEN A GLOBAL VARIABLE “LISTee”, WHERE e€¢€ IS THE NUMBER OF 
[5] eo ENTRIES AND THE VARIABLE IS OF SHAPE (€€,7) OF THE FORM: 

(6] A 

[7] A 1 0100BM_ (°_” DENOTES BLANK) 
({8] A 2 O150MA_ : 
[9] r 3 0401STG 

{10] r 

[11] A : 

[12] ao €€ 8300DN_ 

[13] a 

[14] «4 THEN THE COMMAND “ €€ A_TO_N 'BM MA STGDN' 

[15] a WILL RETURN THE RESULT: 1 2 3 €€ 

[16] a 

(17]  SH#+Op0 

[ve] TOPs 

[19] A+3+RATING 

[20] 2'SH+SH,(AA.#=8(' , (¥SIZE),',3)+4OLIST' ,( *SIZE),')/1',(*SIZE) 7 
( 

[ 

( 
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FUNCTION: BUILD_LOS1 


VMOUT + BUILD_LOS1 YEAR 1M;P;PRIDE_PART;LOS1;Y 
a THIS FUNCTION “PRE-PROCESSES’ THE INVENTORY DATA BY TAKING THE 
eo FULL (7 X¥ 129 X¥ 9 X 21) INVENTORY MATRIX AND REDUCING IT TO 
e THE “ADJUSTED” INVENTORY MATRIX USED BY FUNCTIONS THAT COMPUTE 
a TRANSITION AND ADDITION MATRICES. 
THE ADJUSTMENTS INCLUDE: 
° REDUCING TO 5 PROGRAMS AND LOS 1 THRU 9 ONLY 
° MAKING THE LOS1 DIMENSION = (YEAR - 1). THIS FACILITATES 
COMPUTING A LOS1 + LOS3 TRANSITION RATE. 
¢ PRIOR SERVICE LOS1 IS MADE THE SUM OF ALL NEW 
ACCESSION ( NEWBLOOD') P.S. 
OUTPUT MATRIX IS SHAPE (5 X 69 X¥ 9 XQ). 


dDaodDDPFDrDDD 


a 

OASS '17 CNAQ: [GARVEYXK.APL] SEPTEMBER/DA' 

DASS '12 CNAQ: [GARVEYK.APL] PRIDEFILE/DA' 

OASS '15 CNAQ: [(GARVEYK.APL] PRIORSERVICE/DA' 

Y+88-YEAR- 1 

a 

a PREVIOUS YEAR INVENTORY IS MADE LOS1 (FOR TRANSITIONS ) 

LOS1#+5 129 1++/ [3] @ [Y] 17 

+(V/(5 129 1)*=pLOS1)/ERROR 

A 

oe "“M" IS THE REST OF THE INVENTORY (LOS2 THRU 21) FOR YEAR... 

M+"2 0 O 0+ (88-YEAR] 17 

+(v/(§ 129 9 21)#pM)/ERROR 

eee ee ee ee eee eee eee ee eee ee eee ee 
a PRIDE DATA ARE USED TO GET A DISTRIBUTION OF RATING BY PROGRAM 

a IN LOS1. EMR DATA ARE INADEQUATE BECAUSE MOST IN LOS1 ARE GENDETS. 
AsBwwreaBzsZFB BBs BSEBASZSABSSsPsssesSBtSBTsSstSsesteCni GSS SAssBBsst ss Bs at sete w 2a = 
P+5 129++/fM [y] 12 

+(v/(5 129)=pP)/ERROR 

a 

PRIDE_PART+P SAFE_DIVIDE_BY +/+/P a” PRIDE_PART' =PERCENTAGE IN RATING 
M1 2.3 5:3;1;1]) +(+/+/+/L081 (1 2 3 5;;1] ) « PRIDE_PART([1 2 3 5;] 

a 

a “LOS1_PRIOR” ARE THE ACTUAL “NEWBLOOD” PRIOR SERVICE NUMBERS... 
LOS1_PRIOR++/ [2] 129 9 1+ [y} 15 

a 

o PRINT “PRIOR_SERVICE FROM “NEWBLOOD” FILE AND EMR FOR COMPARISON 
+/+/4+/+/M [455121] 

+/+/LOS1_PRIOR 

a PLACE “NEWBLCOD” DATA AS PRIOR SERVICE, LOS 1, PAYGRADE 1 AND 

a ZERO OUT PAYGRADE 2 THRU Q.. 

M[4;:1:1] +129 1 1pLOS1_PRIOR 

M[::1+18;1] +O 

a 

M+CONDENSE 5 129 9 9+M a 129 RATINGS + 69 RATINGS 

+XIT 

ERROR: 

' SHAPE IS INCORRECT. ' 

+0 

XIT: 

ODAS 12 15 17 

MOUT+M 
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FUNCTION: MAKE_ALLOCATION 


VMOUT+MAKE_ALLOCATION YEAR 

MIN+80 a 1980 IS CURRENTLY THE EARLIEST DATA 
MAX+85 eo 1985 IS CURRENTLY THE MOST RECENT YEAR (LATEST PRIDZ) 
a ¢ 
+( (YEAR 2 MIN) A (YEAR <s MAX) )/CONTINUE 
+YEAR_ERROR 

CONTINUE: 

a 


THIS FUNCTION USES THE “REDUCED” INVENTORY FILE WHERE THE LOS1 
DIMENSION HAS ALREADY BEEN REPLACED BY (YEAR - 1) LOS 1 TO 
PREPARE IT FOR USE IN COMPUTING TRANSITION RATES. IN ORDER TO 
GET THE ACTUAL LOS1 FOR YEAR, IT MUST SELECT DATA FROM \ YEAR + 1). 


Rw B BeBe BRB BSA BAST SAAS SBABABAACBSEBAt eet sstss se Bstssr sar rtezsts22223== 


>PRReDDD 


A 
C+ ASS '12 CNAQ: [GARVEYK.APL] SEPT/DA' 
M+4 (88-YEAR + 1] 12 
+(V/(5,MSHAPE,9,9)=0M)/0 
ALLOCATION++/M (; 3; 1] 

ODAS 12 


a 


QO Bett ease SBP SSBB BTS SBE SASATTASB SSA ETIS AH Bess siete wets sesaswasszast es 


e THE FOLLOWING IF “NEW-BLOOD’ PRIOR SERVICE” ARE TU BE INCLUDED 
a AS LOS1 PRIOR SERVICE IN THE ALLOCATION MATRIX... 


QG seas es en SaTZBnnaBESTSE TSE SASASBEABASSESBEBSBTT SET SRBIASASB Bs eT es AAI ZA Zz 


C+QASS '15 CNAQ: [GARVEYK.APL] PRIORSERVICE/DA' 
PRIOR+ [(88-YEAR)] 15 
+(V/(129 9 21)#pPRIOR)/O 
ODAS 15 
P++/+/PRIOR+CONDENSE PRIOR 
PRIOR_BY_LOS+ROW_PERCENT +/ [2] PRIOR 
ALLOCATION (4;] +P 
mo 
T++/+/ALLOCATION 
D+(5,MSHAPE) pT 
ALLOC_MATRIX+ALLOCATION ZERO_DIVIDE_BY D 
' ( THE ALLOCATION MATRIX SUMS TO ',(¥+/+/ALLOC_MATRIX),' ]' 


a 

0 FORMATTING OF THE OUTPUT 
COLUMN+(+#ALLOCATION)+MSHAPE OT 
ROW+(+/ALLOCATION ) +507 
COLUMN+COLUMN, (+/COLUMN ) 
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ALLOC_MATRIX+ALLOC_MATRIX, [2] 5 1pROW 
ALLOC _MATRIX+ALLOC_MATRIX, [1] (1, (MSHAPE+1))pCOLUMN 
LABEL+(4O0LISTER MSHAPE), [1]1 8p'TOTAL ' 
LABEL+LABEL, [2] ((MSHAPE+1),4)p' ' 

HEADER+1 60p0' RATING 4 YO AM 5/6 YO PRIOR TARS TOTA 
NUMBERS+LABEL, [2] 8 OFRALLOC_MATRIX « T 

NUMBERS+READER, [1] NUMBERS 

' LOS 1 A LoL0 C Af TON FOR 19' ¥YEAR 

1 ' 

NUMBERS 

+XIT 

MOUT+12 8¥8ALLOC_MATRIX 

SHAPE_ERROR: 

' q 

' me ERROR 2nx! 

' ' 

' THE DATA FILE COMPCNENT READ BY THE FUNCTION IS NOT THE SHAPE ' 
' THAT THE FUNCTION EXPECTS...' 

ALLOC_MATRIX+1 190 

+XIT 

YEAR_ERROR: 

' , 


" waz ERROR wuunw ' 

' THE YEAR SPECIFIED IS OUTSIDE THE PERIOD FOR WHICH WE HAVE DATA. ' 
ALLOC_MATRIX+1 1p0 

XIT: 

MOUT+12 8¥RALLOC_MATRIX 
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APPENDIX C 


SELRES DATA AND CALCULATIONS 


This appendix contains descriptions of the methodology, data, and 

‘ some am listings used to measure Selected Reserve (SELRES) affiliation, 

‘ continuation , and inventory distributions by enlistment program. The 
SELRES enlistment prorams include recent Navy Veterans (NAVETs) (except 
Active Mariners), recent Active Mariner NAVETs, Sea and Air Mariners 
(SAMs), and others (OTHERs). The first two reserve enlistment programs 
involve affiliation of prior-service active duty personnel. SAMs are 
non-prior-service personnel recruited directly into SELRES; their number 
is determined by SELRES enlistd strength planners. The OTHER category 
includes Advanced Paygrade (APG) personnel, other service veterans 
(OSVETs), and enlistments by prior service personnel not otherwise 
classified. The last category includes both active duty personnel 
separated from active duty more than 1 year before their affiliation 
with the reserves, and individuals whose most recent affiliation was 
with SELRES. 


-Individual active duty losses for each fiscal year are identified 
from the end-of-fiscal-year Enlisted Master Record (EMR) files from 1979 
through 1985. The first FORTRAN program listed in annex C-1 matches 
these losses to CNA's longitudinal version of the Inactive Enlisted 
Master File (IEMF). The program then calculates affiliation rates for 
Active Mariners and other NAVETs separately for each rating group. 
Gains to SELRES from active duty are counted as affiliations of recent 
losses if the gain is in the same fiscal year as the loss, or in the 
following year. Losses with associated gains are tabulated first by 
enlistment program and rating group. The next section of the program 
calculates the inventories for recent NAVETs and Active Mariners ina 
form suitable for calculating average continuation rates over the 
FY 1979 through FY 1986 period. The final section adds non-matching 
individuals to the denominator for the affiliation rate computation, 
then calculates and prints the affiliation rates. Calculation of 
eontinuation rates proceeds by dividing total inventory in each LOS, 
summed across cohorts, by the total inventory in the previous LOS 
similarly summed. This produces the same result as computing the 
weighted average of continuation rates across the years. The 
continuation rates are presented in table C-1. 


The affiliation rates for FY 1985 recent NAVETs are adjusted in 
2 ratings where the number of losses are small, to reflect a mix of rating 
- and program-spcfic rates and overall affiliation behavior. Such an 
adjustment makes simulated affilia’ ion behavior less susceptible to 
changes in the distribution of active duty losses. It is a Bayesian 
° procedure that moderates observed rates in small cells to a greater 
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extent than large cells. ! Within each program, GENDETs are adjusted 
separately from the other ratings because their affiliation rates are 
much lower. The adjustment is applied to the calculated affiliation 

‘ rates in several steps for the NAVET and Active Mariner rates 
separately. 


First, a two-parameter beta probability distribution is fit to 
4 observed affiliation behavior and these parameters are then applied to 
the observed affiliation rates as in equation C-1: 


2 2 (0-7) 


where a is the adjusted rate, X/N is the observed rate, and 

a/(a + 8) is the mean of the fitted beta distribution. The aijustment 
is always toward the overall mean, and has its biggest effect when the 
cell size (N=losses) is small, and when X/N differs from the fitted 
mean of the distribution. Table C-2 shows adjusted and unadjusted 
affiliation rates based on the behavior of FY 1985 active duty losses. 


Annex C-2 presents the program listings used to determine the 
structure of the FY 1985 SELRES inventory by enlistment program, rating 
group, and LOS. Because the IEMF carries no date field for beginning of 
SELRES affiliation, the LOS must be computed from the difference between 
the observation date and the first time the individual appears as a gain 
to SELRES. SAM LOS 1 inventories by rating are determined by looking 
ahead one year to find the ratings to which SAM GENDET accessions are 
distributed. This is consistent with the calculation of continuation 
rates for SAMs. The resulting inventory appears in table C-3. 


Tabulations of the September 1985 SELRES inventory paygrade 
structure by rating group is presented in table C-4. This is done for 
the purpose of converting the inventory by LOS dimension to an inventory 
dimensioned by paygrade for comparison with the Reserve Enlisted 
Programmed Authorization (EPA). This distribution will be sensitive to 
changes in accessions among enlistment programs, especially SAMs. 

Table C-5 contains the allocation of SAM and OTHER accessions to 
ratings. The SAM allocations can be changed during the simulation. The 
reserve EPA is listed separately for each year, by rating group, in 
table C-6. 


1. For additional discussion of the technique, see John D. Hey, Data in 
Doubt, Basil Blackwell Ltd: Oxford, 1983. 
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TABLE C-2 


FY 1985 SELRES AFFILIATION RATES BY 
RATING AND PROGRAM 


NAVET ACTIVE MARINER 
Rating Aff Loss Actual Adjusted Aff Loss Actual Adjusted 
AN 36 2817 0.0128 0.0133 257 1058 0.2429 0.2414 
AB 67 1032 0.0649 0.0660 141 184 0.7663 0.7578 
AC 32 254 0.1260 0.1204 16 23 0.6957 0.6841 
AF 203 3037 0.0668 0.0672 325 563 0.5737 0.5766 
AG 49 242 0.2025 £0.1841 30 35 0.9091 0.8257 
AK 58 499 0.1162 0.1140 32 64 0.5000 0.5364 
AO 36 749 0.0481 0.0506 149 209 0.7129 0.7095 
AS 26 298 0.0872 0.0877 42 or ©.7368 0.7209 
AV 255 2907 0.0877 0.0878 301 446 0.6749 0.6747 
AW 59 359 0.1643 0.1557 31 48 0.6458 0.6520 
AZ 49 426 0.1150 0.1126 46 77 «€=6©60.5974 0.6107 
BM 186 1602 O.1161 #4«®20.1154 349 403 0.8660 0.8578 
BT 78 1791 0.0436 0.0448 144 aor 0.6076 0.61126 
CN ) 75 0.0000 0.0136 0 27 0.0000 0.1520 
CTA 12 81 0.1481 0.1268 2 6 0.3333 0.5836 
CTI 20 128 0.1563 0.1384 if 4 0.2500 0.5913 
CTM 25 199 0.1256 0.1188 3 5 0.6000 0.6537 
CTO 30 170. O.1768 0.2677 3 6 0.5000 @:6260 
CTR 24 164 0.1463 0.13538 9 1S 0.6923 0.6789 
CTT 24 202 0.1188 0.1134 4 9 0.4444 0.5930 
CU 43 549 0.0783 0.07938 55 82 0.6707 0.6704 
DT 70 320 0.2188 0.2022 26 44 0.5909 0.6132 
DK 26 275 0.0952 0.0945 20 28 0.7143 0.6968 
DM 5 44 0.1136 9.1016 6 f 0.8571 0.7226 
DP 87 S75 0.1513 0.1467 24 55 0.6857 0.6801 
DS 29 422 0.0687 0.0709 2 10 0.2000 0.4990 
EM 186 2743 0.0678 0.0682 150 198 0.7576 0.7504 
EN 114 1283 0.0889 0.0889 193 256 0.7539 0.7485 
EQ 34 472 0.0720 0.0737 91 lgy 60.7165 «|. 7108 
ET 146 2021 0.0722 0.0727 42 74@ O.5676 0.5870 
EW 27 o10 0.0871 0.0875 29 42 0.6905 0.6841 
FN 57 2725 0.0209 0.0186 314 1067 0.2943 0.2899 
FT 70 1128 0.0621 0.0632 90 120 0.7500 0.7397 
GM 78 838 0.0931 0.0929 174 213 0.8169 0.8056 
GS 21 321 0.0654 0.0686 2 8 0.2500 0.5380 
HM 552 2872 0.1922 0.1905 170 262 0.6489 0.6501 
HT 189 1806 0.1047 0.1043 250 331 0.7553 0.7509 
Is aleve 110 0.1545 0.1352 a 4 24 0.7083 0.6917 
JO 10 78 0.1282 0.1189 4 9 0.4444 0.5930 
LI 5 54 0.0926 0.0916 6 9 0.6667 0.6682 
LN 9 45 0.2000 0.1437 1 1 1.0000 0.6868 
MA 1 118 0.0085 0.0320 1 Zz 0.5000 0.6516 
ML 2 31 0.0645 0.0802 3 6 0.5000 0.6260 
MM 179 4141 0.0432 0.0438 128 215 0.5953 0.6009 
MN 7 36 6D Te80°6=— sO. L091 10 15 0.6667 0.6679 
MR 58 368 0.1033 0.1018 61 79 0.7722 0.7534 
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TABLE C-2 (Continued) 


NAVET ACTIVE MARINER 
f Loss Actual Adjusted Aff Loss Actual Adjusted 
2542 G.0767 920.0770 141 260 0.5423 0.5503 
79 0.0000 0.0340 0 0 si hel 0.6690 
113 0.0000 0.0268 0 0 ET eae 0.6690 
1748 0.0961 0.0960 148 221 0.6697 0.6696 
214 GO; 0701 0.0738 5 9 0.5556 0.6306 
136 0.0368 0.0507 20 21 0.9524 0.8233 
341 ©.1466 (01896 9 13 0.6923 0:8769 
116 0.0776 @.0619 7 11 0.6364 0.6565 
6 0.0000 0.0803 0 0 ere ee 0.6690 
754 0.0889 0.0890 41 89 0.4607 0.4950 
LS 0.0800 0.0822 10 24 0.4167 0.5234 
582 0.0945 0.0942 82 116 0.7069 0.7019 
1956 0.1242 0.1234 210 174 0.6322 0.6356 
126 O-252ee 0. 1881 6 mt 0.5455 0.6215 
10322 0.0131 0.0132 479 2705 0.1771 0. 1780 
728 0.0838 0.0842 36 62 0.5806 0.6002 
948 Osli7i 0.1156 141 213 0.6620 0.6625 
437 0.0801 6.0811 42 75 0.5600 0.5807 
861 0.0348 0.0378 39 70 0.5571 0.5796 
3350 0.0121 0.0220 6 19 0.3158 0.4855 
564 Onis, ‘0. hla 40 61 0.6557 0.6587 
325 0.0681 0. OF 20 48 66 0.7273 0.7150 
1443 0.0942 0.0Y41 56 131 0.4275 0.4561 
BETA DISTRIBUTION PARAMETERS 
(ALPHA, BETA) 
NAVET AM 
GENDET (20.52, 1,413.79) (13.882, 50.15.) 
RATED (4.30, 43.21) Clie, 5.682) 
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ANNEX C-1 
PROGRAM LISTINGS FOR COMPUTING 
SELRES AFFILIATION AND CONTINUATION RATES 
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PROGRAM MATCH_LOSS 


IMPLICIT NONE 


! LOSS-FILE VARIABLES 


STRUCTURE 
INTEGER 


/LOSS_FILE/ 
SSN, STR_LOiS , LOSS_REASON 


CHARACTER*2 RQC 


INTEGER 


PROGRAM , RATING, PAYGRADE, LOS 


END STRUCTURE 
RECORD /LOSS_FILE/ CURR,NEXT 
° INTEGER EOF_A, EOF_N 


INTEGER T_ 


TYPE. 


INTEGER FY,KRATE, PG 
INTEGER LOSS_YR_A, LOSS_YR_N 


INTEGER T_ 


TYPE, RoTYPE 


COMMON /SUBSCRIPT/CURR, NEXT, LOSS_YR_A, LOSS_YR_N,T_TYPE,R_TYPE 
EXTERNAL HANDLER 


INTEGER*4 
REAL 


INTEGER*2 
INTEGER 
INTEGER 
INTEGER 
INTEGER 
INTEGER 
LOGICAL 
INTEGER 


LOSS(6,109),GAIN(6,109,0:10,11,3),GAIN_AF(6,109) 
RATE(6) 


I,dJ,LOS,L,M,N,P,1I0,ST 

UP, UPFLAG ,GAIN_CNT, LOSS_CNT 

TEMAC , TEMAC_NO_MATCH , OLD_MATCH , OLD_NO_MATCH 
T_TYPE_CNT(3),R_TYPE_CNT(2), PREV_CNT,CNT_943,GP 


‘INCNT1 , INCNT2 


AA, BB 
PREV 
GAIN_TOT(2) ,LOSS_TOT(2) 


CHARACTER*3 RATE_NAME( 109) 
COMMON /KEVIN_RATING/RATE_NAME 


! IEMF-LONGIT VARIABLES 
STRUCTURE /LONGIT_FILE/ 
INTEGER SSN,YRFLAG(11),RATING(11), PAYGRADE( 11) 
END STRUCTURE 
RECORD /LONGIT_FILE/ LONG 
INTEGER EOF_I 


CALL LIBSESTABLISH( HANDLER ) 


CALL KEVIN_TO_RATING(0,0,0,0) 


CALL READ_LOSSES(CURR, EOF_A) 
: INCNT1=INCNT1+1 
, LOSS_YR_A=FY (CURR. STR_LOSS ) 
DO WHILE (LOSS_YR_A.LT.4) 
CALL READ_LOSSES(CURR, EOF_A) 
5 INCNT1=INCNT1+1 
LOSS_YR_A=FY(CURR.STR_LOSS ) 


END DO 
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CALL READ_LOSSES(NEXT, EOF_N) 
INCNT1=INCNT1+1 
LOSS_YR_N=FY(NEXT.STR_LOSS ) 
DO WHILE (LOSS_YR_N.LT.4) 
CALL READ_LOSSES(NEXT, EOF_N) 
INCNT1=INCNT1+1 
LOSS_YR_N=FY(NEXT.STR_LOSS) 
END DO 


CALL READ_LONGIT(LONG, EOF_I) 
INCNT2=INCNT2+1 
AA=0 
BB=0 
WRITE(6,*) ' GAINS LOSSES TEMAC ' 


DO WHILE (EOF_A.EQ.0) 


IF (AA.EQ.10000) THEN 

AA=0 

BB=BB+1 

WRITE(6,*) BB,GAIN_CNT, LOSS_CNT, TEMAC 
END IF 
AA=AA+1 


IF (CURR.SSN.EQ.LONG.SSN) THEN 
a if not TEMAC 
IF (LOSS_YR_A.EQ.1) THEN 
PREV=.TRUE. 
ELSE 
PREV= (LONG. YRFLAG(LOSS_YR_A-1).NE.1) 
END IF 
IF (((CURR.LOSS_REASON.NE.943).OR. (CURR. PROGRAM. EQ. 2) ) 
* .AND. PREV ) THEN 
IF (LOSS_YR_A.EQ.10) THEN 
IF ((CURR. PROGRAM. EQ.1).OR.(CURR.PROGRAM.EQ.3).OR. 
* (CURR. PROGRAM. EQ.4) .OR. (CURR. PROGRAM. EQ.5).OR. 
* (CURR. PROGRAM.EQ.6)) THEN 
LOSS(1,CURR.RATING)=LOSS(1,CURR.RATING)+1 
IF (CURR.PROGRAM.EQ.1) THEN 
LOSS(3, CURR. RATING) =LOSS(3,CURR.RATING)+1 
ELSE 
IF (CURR. PROGRAM.EQ.3) 
* LOSS(4,CURR.RATING)=LOSS(4,CURR.RATING)+1 
END IF 
ELSE 
LOSS(2,CURR.RATING)=LOSS(2, CURR.RATING)+1 
END IF 
IF (CURR.LOS.LE.6) THEN 
LOSS(5,CURR.RATING)=LOSS(5,CURR. RATING) +1 
ELSE 
LOSS(6,CURR.RATING)=LOSS(6, CURR. RATING) +1 
END IF 
LOSS_CNT=LOSS_CNT+1 
ELSE 
OLD_MATCH=OLD_MATCH+1 
END IF 
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IF (CURR.SSN.EQ.NEXT.SSN) THEN 
UP=LOSS_YR_N-1 
UPFLAG=1 
ELSE 
UP=11 
UPFLAG=0 
END IF 


DO I= LOSS_YR_A,UP 
IF (LONG. YRFLAG(I).EQ.1) THEN 
CALL TYPE_GAIN(CURR, LONG, LOSS_YR_A,I,UP, 
: T_TYPE,R_TYPE,KRATE, PG, LOSS_CNT) 
IF (TLTYPE.LE:2) THEN 
TEE. Tat Prey 


J=I 
DO WHILE ((J3.L* .).AND. (LONG. YRFLAG(J).EQ.1)) 
LOS=d-I 
CALL TYPE_GAIN(CURR,LONG,LOSS_YR_A,d,UP, 
x T_TYPE,R_TYPE,KRATE,PG,LOSS_CNT) !get “current” 
IF ((CURR.PROGRAM.EQ.1).OR.(CURR. PROGRAM. EQ.3).OR. 
* (CURR. PROGRAM. EQ.4).OR. (CURR. PROGRAM. EQ.5).OR. 
A (CURR. PROGRAM.EQ.6)) THEN 
GAIN(1,KRATE, LOS, LOSS_YR_A, T_TYPE_T)= 
* GAIN(1,KRATE,LOS, LOSS_YR_A,T_TYPE_T)+1 
IF (CURR. PROGRAM.EQ.1) THEN 
GAIN(3,KRATE,LOS, LOSS_YR_A,T_TYPE_T)= 
* GAIN(3,KRATE, LOS, LOSS_YR_A, T_TYPE_T)+1 
ELSE 
IF (CURR.PROGRAM.EQ.3) 
x GAIN(4,KRATE,LOS,LOSS_YR_A, T_TYPE_T)= 
* GAIN(4,KRATE,LOS,LOSS_YR_A, T_TYPE_T)+1 
END IF 
ELSE 
GAIN(2,KRATE, LOS, LOSS_YR_A, T_TYPE_T)= 
* GAIN(2,KRATE,LOS,LOSS_YR_A,T_TYPE_T)+1 
END IF 


IF (CURR.LOS.LE.6) THEN 
GAIN(5,KRATE, LOS, LOSS_YR_A, T_TYPE_T)= 


be GAIN(5,KRATE,LOS, LOSS_YR_A, T_TYPE_T)+1 

ELSE 

GAIN(6,KRATE,LOS,LOSS_YR_A, T_TYPE_T)= 

GAIN(6,KRATE,LOS, LOSS_YR_A,T_TYPE_T)+1 

END IF 

J=J+1 

END DO 
END IF 


IF (PG.NE. CURR.PAYGRADE) GP=GP+1 
GAIN_CNT=GAIN_CNT+1 
T_TYPE_CNT(T_TYPE)=T_TYPE_CNT(T_TYPE)+1 
R_TYPE_CNT(R_TYPE)=R_TYPE_CNT(R_TYPE)+1 


GOTO 100 
END IF ! YRFLAG MATCH? 
END DO ! DO ALL POSSIBLE GOOD YRFLAGS 
100 CONTINUE 


ELSE 
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TEMAC=TEMAC+1 
IF (.NOT.PREV) THEN 
PREV_CNT=PREV_CNT+1 
ELSE 
CNT_943=CNT_943+1 
END IF 
END IF 


CURR=NEXT 
EOF_A=EOF_N 
LOSS_YR_A=LOSS_YR_N 
CALL READ_LOSSES( NEXT, EOF_N) 
INCNT1=INCNT1+1 
LOSS_YR_N=FY(NEXT.STR_LOSS ) 
DO WHILE (LOSS_YR_N.LT.4) 
CALL READ_LOSSES(NEXT, EOF_N) 
INCNT1=INCNT1+1 
LOSS_YR_N=FY(NEXT.STR_LOSS ) 
END DO 
ELSE 
IF (CURR.SSN .LT. LONG.SSN) THEN 
C if not TEMAC 
IF (CURR.LOSS_REASON.NE.943)THEN 
IF (LOSS_YR_A.EQ.10) THEN 


IF ( (CURR. PROGRAM.EQ.1).OR. (CURR. PROGRAM.EQ.3).OR. 
i (CURR. PROGRAM.EQ.4).OR. (CURR. PROGRAM.EQ.5).OR. 


. (CURR. PROGRAM.EQ.6)) THEN 
LOSS(1,CURR.RATING)=LOSS(1,CURR.RATING)+1 
IF (CURR.PROGRAM.EQ.1) THEN 
LOSS(3,CURR.RATING)=LOSS(3,CURR.RATING)+1 
ELSE 
-IF (CURR. PROGRAM. EQ.3) 
x LOSS(4, CURR. RATING) =LOSS(4,CURR.RATING)+1 
END IF 
ELSE 
LOSS(2,CURR.RATING)=LOSS(2,CURR.RATING)+1 
END IF 
IF (CURR.LOS.LE.6) THEN 
LOSS(5, CURR. RATING) =LOSS(5,CURR.RATING)+1 
ELSE 
LOSS(6, CURR. RATING )=LOSS(6,CURR.RATING)+1 
END IF 
LOSS_CNT=LOSS_CNT+1 
ELSE 
OLD_NO_MATCH=OLD_NO_MATCH+1 
END IF 
ELSE 
TEMAC_NO_MATCH=TEMAC_NO_MATCH+1 
END IF ! TEMAC 
CURR=NEXT 
EOF_A=EOF_N 
LOSS_YR_A=LOSS_YR_N 
CALL READ_LOSSES(NEXT, EOF_N) 
INCNT1=INCNT1+1 
LOSS_YR_N=FY(NEXT.STR_LOSS) 
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DO WHILE (LOSS_YR_N.LT.4) 
CALL READ_LOSSES( NEXT, EOF_N) 
INCNT1=INCNT1+1 
LOSS_YR_N=FY(NEXT.STR_LOSS) 
END DO 
ELSE 
CALL READ _LONGIT( LONG, EOF_I) 
INCNT2=INCNT2+1 


: END IF 
END IF | §SN-MATCH? 
END DO 
, WRITE(6, *) 
WRITE(6,*) ‘LOSS FILE RECORDS READ= ' INCNT1 
WRITE(6,*) ‘LOUTT FILE RECORDS READ= ',INCNT2 
WRITE(6,*) ‘MerUNING SSNs W/ LOSS PRIOR TO 84 ‘ OLD_MATCH 
WRITE(6,*) ‘NON-MATCHING SSNs W/ LOSS PRIOR TO 84',OLD_NO_MATCH 
WRITE(6,*) ' GAIN_CNT= ',GAIN_CNT,'’ LOSS_CNT= ',LOSS CNT 
WRITE(6,*) ‘ TEMACS= ',TEMAC,’ TEMAC BY PREV= ',PREV_CNT, 


x TEMAC BY 943= ' ,CNT_943 

WRITE(6,*) ‘ NON-MATCFING TEMAC’' , TEMAC_NO_MATCH 
WRITE(6,*) ‘T_TYPE_CNT: ‘,(T_TYPE_CNT(I),I=1,3) 
WRITE(6,*) ‘R_TYPE CNT: ‘',(R_TYPE_CNT(I),I=1,2) 
WRITE(6,*) ‘GAINS W/ DIFF PG’,GP 


WRITE(6, *) 
INCLUDE ‘WRITE_MATCHS /LIST' 


END 
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DO J=1,69 
DO I=1,6 
GAIN_AF(1I,J)=GAIN(I,J,0,10,1)+GAIN(I,J,0,10,2) 
END DO 
END DO 
WRITE(7,*) ' TABLE OF SELRES AFFILIATION’ 
WRITE(7,*) ’ RATING BY PROGRAM’ 
WRITE(7,*) 
WRITE(7,*) ‘ 4Y0,5/6YO,PS,TAR A/M 
DO J=1,69 
CALL WRITE_LINE(RATE_NAME(J),GAIN_AF(1,J),GAIN_AF(2,d), 
* LOSS( 1,3), LOSS(2,7)) 
DO I=1,2 


GAIN_TOT(I)=GAIN_TOT(I)+GAIN_AF(I,d) 
LOSS_TOT(I)=LOSS_TOT(I)+LOSS(I,J) 


END DO 
END DO 
WRITE(7,*) ‘total’,(GAIN_TOT(I),LOSS_TOT(TI), 
- REAL(GAIN_TOT(I))/REAL(MAX(LOSS_TOT(I),1)),I=1,2) 
DO I=1,2 


GAIN_TOT(I)=0 
LOSS_TOT(I)=0 


END DO 
WRITE(7,*) 
WRITEC ZT, *) * TABLE OF SELRES AFFILIATION ' 
WRITEC? 4) ~ RATING BY PROGRAM’ 
WRITEC7,,*) 4YO 5/6YO ' 
DO J=1.69 

CALL WRITE_LINE(RATE_NAME(J),GAIN_AF(3,dJ),GAIN_AF(4,J), 
* LOSS(3,J),LOSS(4,d)) 

DO I=1,2 


GAIN_TOT(I)=GAIN_TOT(I)+GAIN_AF(I+2,d) 
LOSS_TOT(I)=LOSS_TOT(I)+LOSS(I+2,d) 


END DO 
END DO 
WRITE(7,*) ‘total’ ,(GAIN_TOT(I),LOSS_TOT(I), 
* REAL(GAIN_TOT(1i) )/REAL(MAX(LOSS_TOT(I),1)),I=1,2) 
DO I=1,2 


GAIN_TOT(I)=0 
LOSS_TOT(I)=0 
END DO 
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WRITECT 7D 
WRITE(7,*) TABLE OF SELRFS AFFILIATION’ 
WRITE(7,*) ' RATING BY LOS’ 
WRITE(7, *) 
WRITEC?,*%) ~ =. 6 YRS =% TRS. 
DO J=1,69 

CALL WRITE_LINE(RATE_NAME(J),GAIN_AF(5,J),GAIN_AF(6,d), 

; : LOSS(5,d),LOSS(6,J)) 
DO I=1,2 


GAIN_TOT(I)=GAIN_TOT(I)+GAIN_AF(I+4,J) 
LOSS_TOT(I)=LOSS_TOT(I)+LOSS(I+4,J) 

‘ END DO 

END DO 

WRITE(7, *) “*otel”. (GAIN TOT(T), LOSS_TOT(T)., 

* REAL(GAIN_TOT(I))/REAL(MAX(LOSS_TOT(I),1)),I=1,2) 


DO TUIXEEal 2 
DO L=1,11 
DO LOS=0,10 
DO J=1,69 
WRITE(8,*) (GAIN(I,dJ,LOS,L,T_TYPE) ,I=1,6) 
END DO 
END DO 
END DO 
END DO 
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SUBROUTINE READ_LOSSES(IN, EOF) 
IMPLICIT NONE 


STRUCTURE /LOSS_FILE/ 
INTEGER SSN,STR_LOSS , LOSS_REASON 
CHARACTER*2 RQC 
INTEGER PROGRAM, RATING, PAYGRADE, LOS 
END STRUCTURE 
RECORD /LOSS_FILE/ IN 


INCLUDE ‘($FORIOSDEF)/NOLIST’ 


INTEGER EOF ,TMP 
INTEGER IERR 


0 CONTINUE 
READ(1,100, END=900, ERR=990 , IOSTAT=IERR ) 
a IN.SSN,IN.STR_LOSS,IN.LOSS_REASON ,IN.RQC, 
i IN. PROGRAM, IN.RATING,IN.PAYGRADE,IN.LOS 
00 FORMAT(I9,I4,13,A2,X,12,313) 


IF (IN.LOS .GE.21) THEN 
IN.LOS=21 
ELSE 
IF (IN.LOS .LE. 0) THEN 
WRITE (6,*) ‘READ LOSS>»» OLD LOS = ‘',IN.LOS,‘ CONVERTED TO 1’ 
IN.LOS=1 
END IF 
END IF 


CALL KEVIN_TO_RATING(3,IN.RATING, TMP,0O) 
IN . RATING=TMP 


RETURN 
300 CONTINUE 


IN. SSN=999999999 
EOF=1 


RETURN 
990 CONTINUE 


IF (IERR.EQ. FORSIOS_INPCONERR) THEN 
WRITE(6,*) ‘READ_LOSS>> BAD RECORD: ', 


* IN.SSN,IN.STR_LOSS, IN. LOSS_REASON ,IN.RQC, 

‘ IN. PROGRAM, IN.RATING, IN. PAYGRADE,IN.LOS 
GOTO 10 

END IF 

WRITE(6,*) ‘READ_LOSS>> INPUT ERROR: ’ ,IERR 

STOP 

END 
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SUBROUTINE READ_LONGIT(IN, EOF) 
IMPLICIT NONE 


STRUCTURE /LONGIT_FILE/ 

INTEGER SSN,YRFLAG(11),RATING(11),PAYGRADE( 11) 
END STRUCTURE 
RECORD /LONGIT_FILE/ IN 


INCLUDE '($FORIOSDEF )/NOLIST' 


INTEGER EOF 
INTEGER IERR,T 


CONTINUE 

READ(2,100, END=900 , ERR=990 , IOSTAT=IERR ) 

* IN.SSN, (IN.YRFLAG(T),T=1,11),(IN.RATING(T),IN.PAYGRADE(T),T=1,11) 
FORMAT(I9,111I1,11(1I4,11,X)) 


RETURN 
CONTINUE 


IN.SSN=999999999 
EOF=1 


RETURN 


CONTINUE 

IF (IERR.EQ. FOR$IOS_INPCONERR) THEN 
WRITE(6,*) ‘READ_LONGIT>>» BAD RECORD: ', 

* IN.SSN,(IN.YRFLAG(T),T=1,11), 

; (IN.RATING(T) , IN. PAYGRADE(T),T=1,11) 


GOTO 10 
END IF 
WRITE(6,*) ‘READ_LONG>> INPUT ERROR: ’,IERR 
STOP 
END 
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INTEGER FUNCTION FY(YYMM) 
IMPLICIT NONE 
INTEGER YYMM, YY,MM 


YY=INT(YYMM/100) 
MM=YYMM-~YY*100 


IF (MM.LE.9) THEN 
FY=YY 

ELSE 
Frsrit. 

END iF 


FPo=FyY~75 


END 


SUBROUTINE WRITE_LOSS(OUTFILE, OUT, FIRST) 


STRUCTURE /LOSS_FILE/ 
INTEGER SSN, STR_LOSS , LOSS_REASON 
CHARACTER*2 RQC 
INTEGER PROGRAM, RATING, PAYGRADE, LOS 
END STRUCTURE 
RECORD /LOSS_FILE/ OUT 


INTEGER OUTFILE,FIRST 


IF (FIRST.EQ.1) THEN 
WRITE(OUTFILE, 10) 
FORMAT(' ‘) 

END IF 


_WRITECOUTFILE, 110) OUT.SSN,OUT.STR_LOSS,OUT.LOSS_REASON, OUT.RQC, 
OUT. PROGRAM, OUT.RATING ,OUT. PAYGRADE , OUT. LOS 
" PORMAT(1X,19, 12,14, I3,A2,413) 


RETURN 
END 
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SUBROUTINE WRITE_LONG(OUTFILE, OUT, FIRST) 


STRUCTURE /LONGIT_FILE/ 

INTEGER SSN, YRFLAG(11),RATING(11), PAYGRADE( 11) 
END STRUCTURE 
RECORD /LONGIT_FILE/ OUT 


INTEGER OUTFILE,FIRST 
INTEGER T 


IF (FIRST.EQ.1) THEN 
. WRITE(OUTFILE, 10) 
10 FORMAT(’ ') 
END IF 


_WRITE(OUTFILE, 100) OUT.SSN, (OUT. YRFLAG(T),T=1,11), 
(OUT.RATING(T),OUT. PAYGRADE(T). T=1,11) 
100 “FORMAT(IZ. 10.38 4i22. Lids.14 21) 


RETURN 
END 
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SUBROUTINE TYPE_GAIN( CURR, LONG, LOSS_YR_A,I,UP, 
- T2t OPE, ROPE, RRATE. PG, LOSS CNT) 


IMPLICIT NONE 


STRUCTURE /LOSS_FILE/ 
INTEGER SSN, STR_LOSS, LOSS_REASON 
CHARACTER*2 RQC 
INTEGER PROGRAM, RATING, PAYGRADE, LOS 

END STRUCTURE 

RECORD /LOSS_FILE/ CURR 


STRUCTURE /LONGIT_FILE/ 

INTEGER SSN, YRFLAG(11),RATING(11),PAYGRADE(11) 
END STFUCTURE 
RECORD /LONGIT_FILE/ LONG 


INTEGER LOSS_YR_A,UP,T_TYPE,R_TYPE,ST,KRATE, PG, LOSS_CNT 
INTEGER*2 I 
INTEGER I0 


IF (LOSS_YR_A.EQ.1) THEN 
T_TYPE=1 
ELSE 
IF (LOSS_YR_A.EQ.I-1) THEN 
T_TYPE=2 
ELSE 
T_TYPE=3 
END IF 
END IF 


PG=LONG. PAYGRADE(I) 
ST=2 
CALL KEVIN_TO_RATING(ST, LONG. RATING(I) ,KRATE, LOSS_CNT) 
IF (ST.EQ.99) THEN 
DO I0=I,UP 
ST=2 
CALL KEVIN_TO_RATING(ST, LONG. RATING(IO:) ,KRATE, LOSS_CNT) 
IF (ST.NE.99) THEN 
PG=<LONG. PAYGRADE( IO) 
GOTO 50 
END IF 
END DO 
WRITE(6,*) ‘TYPE_RATING>> NO RATING @' ,LOSS_CNT 
KRATE=96 
END IF 
50 CONTINUE 


IF ((CURR.RATING .EQ. KRATE).AND. 
‘ (eG .EQ. CURR.PAYGRADE)) THEN 
R_TYPE=1 
ELSE 
R_TYPE=2 
END IF 


RETURN 
END 
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SUBROUTINE KEVIN_TO_RATING( STATE,RO,R,INCNT) 
IMPLICIT NONE 
INTEGER STATE,RO,R,INCNT 


INTEGER KEVIN(140),RATING( 140) 
INTEGER I 


CHARACTER*3 RATE_NAME( 109) 
COMMON /KEVIN_RATING/RATE_NAME 


INITIALIZE 


IF (STATE EQ.0) GOTO 1000 


C CONVERT KEVIN RATINGS TO 4-DIGIT RATING CODE 


IF (STATE.EQ.1) GOTO 2000 


C CONVERT 4-DIGIT RATING CODES TO KEVIN RATING 


C CONVERT OLD-KEVIN RATING (1..129) TO Total-Force 


C 


100 


IF (STATE.EQ.2) GOTO 3000 


RATING (1..108,109=OTH ) 


or TO Total-Force RATING (1..69,70=OTH) 


IF (STATE.EQ.3) GOTO 4000 


WRITE(6,100) STATE 
FPORMAT(1X, ‘CHECK RATING> > 
RETURN 


C INITIALIZE 


1000 


1010 


1100 


1900 


CONTINUE 
I=0 


CONTINUE 
I=I+1 


BAD STATE PASSED; STATE=' ,I4) 


READ(3,1100,END=1900) KEVIN(I),RATE_NAME(KEVIN(I)),RATING(TI) 


FORMAT(X,13,2X,A3,1X,14) 
GOTO 1010 


CONTINUE 
CLOSE(1) 
RETURN 


C CONVERT KEVIN RATINGS TO 4-DIGIT RATING CODE 


2000 


2100 


CONTINUE 


DO I=1,129 
IF (RO.EQ.KEVIN(I)) THEN 
R=RATING(I) 
GOTO 2100 
END IF 
END DO 
WRITE(6, *) 
CONTINUE 
RETURN 


‘CHECK RATING>> BAD RATING: 


€=39 


‘ RO, ' 


@ ',INCNT 


CONVERT 4-DIGIT RATING CODES TO KEVIN RATING 


100 


.00 


CONTINUE 


DO I=#1,129 : 
IF (RO.EQ.RATING(I)) THEN 
R=KEVIN(TI) 
GOTO 3100 
END IF 
END DO 
IF (RO.EQ.9909) STATE=99 
WRITE(6,*) ‘CHECK RATING>>» BAD RATING: ‘',RO,' @ ‘,INCNT 
CONTINUE 
RETURN 


CONVERT OLD-KEVIN RATING TO NEW KEVIN-RATING 


100 


CONTINUE 
IF ((1.LE.RO).AND.(RO.LE.129)) THEN 

R=KEVIN( RO ) 
ELSE 

WRITE(6,*) ‘CHECK RATING>>» BAD OLD-KEVIN RATING ',RO,’ @ ',INCNT 
END IF 
RETURN 


END 
SUBROUTINE WRITE_LINE(LABEL, ONE, TWO, THREE, FOUR) 
CHARACTER*3 LABEL 


INTEGER*4 ONE, TWO, THREE, FOUR 
INTEGER*4  NUM(2),DEN(2) 


INTEGER E 


NUM(1)=ONE 
NUM(2)=TWO 
DEN(1)=THREE 
DEN(2)=FOUR 


IF (DEN(1).NE.0) THEN 
IF (DEN(2).NE.0) THEN 
WRITE(7,100) LABEL, 
(NUM(I),DEN(I),REALC(NUM(I))/REAL(DEN(I)),I=1,2) 
ELSE 
WRITE(7,110) LABEL, 
NUM(1),DEN(1),REAL(NUM(1))/REAL(DEN(1)),NUM(2) 
END IF 
ELSE 
IF (DEN(2).NE.0) THEN 
WRITE(7,120) LABEL, 
NUM(1),NUM(2),DEN(2),REAL(NUM(2))/REAL(DEN(2)) 
ELSE 
WRITE(7,130) LABEL,NUM(1),NUx(2) 
END IF 
END IF 
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100 FORMAT(1X,A3,2(3X,15,3X,15,3X,F4.2)) 


10 FORMAT(1X,A3,3X%,15,3K,15,3K,F4.2,3K,15,7X,‘'0',3X,‘'----',' «----') 
120 FORMAT(1X,A3,3X,I5,7X, ‘0’ ,3X, ‘----',3X,I15,3%,15,3X,F4.2,' «----') 
130 PORMAT (1X AG, 32 05. 7S, 0° ”.38,°=---" 32,19, 7%.'O" 3k, ===", * ase") 
RETURN 
END 
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ANNEX C-2 


PROGRAM LISTINGS FOR TABULATING SELRES INVENTORY 
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IDENTIFICATION DIVISION. 


PROGRAM-ID. INV84-AGG. 
AUTHOR. J GROGAN. 
INSTALLATION. CNA. 
DATE-WRITTEN . 11/06/86. 
DATE-COMPILED. 

SECURITY. UNCLASSIFIED. 


ENVIRONMENT DIVISION. 
CONFIGURATION SECTION. 
SOURCE-COMPUTER. VAX-11-780. 
OBJECT-COMPUTER. VAX-11-780. 


INPUT-OUTPUT SECTION. 
FILE-CONTROL. 


SELECT INFILE ASSIGN TO IFILE. 
SELECT INFILE2 ASSIGN TO IFILE2. 
SELECT OUTFILE1 ASSIGN TO OFILE1. 
SELECT OUTFILE2 ASSIGN TO OFILE2. 
SELECT PRINTFILE ASSIGN TO PFILE. 


DATA DIVISION. 
FILE SECTION. 


FD 


Ol 


FD 


O02 


FD 


01 


FD 


INFILE 
RECORD CONTAINS 14 CHARACTERS 
DATA RECORD I INREC. 


INREC. 

O05 FILLER PIC Zz. 

O05 RATE-NUM-IN PIC 2(3). 
O05 FILLER PIC X(2). 
O05 ALPHA-RATE-IN PIC X(3). 
O05 FILLER PIC 201): 
05 RATECODE-IN PIC 9(4). 
INFILE2 


RECORD CONTAINS 86 CHARACTERS 
DATA RECORD IS INREC2. 


INREC2. 
O05 SSN PIC X(9Q). 
O05 YEAR-FLAG OCCURS 11 TIMES 

PIC. SC 1). 
O05 FILLER PIC X(54). 
OS RCODE PIC 2(3)9. 
O05 FILLER PIC X(8). 
OUTFILE1 


RECORD CONTAINS 86 CHARACTERS 
DATA RECORD IS OUTREC1. 


OUTREC1. 
O05 FILLER PIC X(86). 
OUTFILE2 

RECORD CONTAINS 51 CHARACTERS 
DATA RECORD IS OUTREC2. 
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OUTREC2. 
O05 RATING-OUT PIC Z(3). 
O05 LOS-DATA OCCURS 8 TIMES. 
10 FILLER PLC RCS). 
16. ANVv-OUT PIC 9(4). 
PRINTFILE 


DATA RECORD IS PRINTLINE. 


PRINTLINE PIC X(80). 


WORKING-STORAGE SECTION. 


Ol 


Ol 


01 


01 


O01 


FILE-COUNTERS. 


O05 PARCNT PIC 9(4) USAGE COMP. 
O05 EOF PIC 9(1) USAGE COMP. 
O05 EOF2 PIC 9(1) USAGE COMP. 
O05 INCNT PIC 9(6) USAGE COMP. 
05 INCNT2 PIC 9(6) USAGE COMP. 
05 OUTCNT1 PIC 9(6) USAGE COMP. 
QOS OUTCNT2 PIC 9(6) USAGE COMP. 
STATEMENT. 

O05 VAR-LABEL PIC S035). 

05 VAR-NUMBER-1 PIC 2(1)9(1). 

05 VAR-NUMBER PIC 2(9)9(1). 


JIM-COUNTERS. 


05 TOTAL PIC 9(7) USAGE COMP. 
O05 NO-MATCH PIC 9(7) USAGE COMP. 
O05 PTR PIC 9(3). 
O5 RATE-NUM-IN-T PIC 9(3). 
05 RCODE-T PIC 9(4). 
O05 YEAR PIC S9(2). 
O05 RNUM PIC 9(3). 
05 GAIN-YEAR PIC 9(2). 
o5 Los PIC 9(2). 
05 DONE PIC 9(1). 
O05 D-CNT PIC 9(6) USAGE COMP. 


RATECODE-TABLE. 

O05 RATECODE-DATA OCCURS 129 TIMES 
ASCENDING KEY IS RATECODE 
INDEXED BY R-INDEZ. 


10 RATE-NUM PIC 9(3). 
10 RATECODE PIC 9(4). 
10 ALPHA-RATE PIC XC3S). 


NAVET-TABLE. 
O05 NAVET-RATE OCCURS 70 TIMES. 
10 INV OCCURS 8 TIMES PIC 9(6). 
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PROCEDURE DIVISION. 
MAIN SECTION. 


Re RR eae TTT WWW WW ow el 6 aoe e eoeee atts ee 
» 


OVERALL-STRUCTURE. Be 
PERFORM 100-BEGINNING. ~ 
PERFORM 325-SETUP-RATE-TABLE. 


? 


PERFORM 400-—MAIN-FILE-LOGIC a 

UNTIL (EOF2 = 1). p 

: PERFORM 1000-TERMINATION. x 
i STOP RUN. " 
EXIT-OVER-STRUCTURE. 5 
Sarr: , 

: ‘e 
' 100-BEGINNING. » 


OPEN INPUT INFILE, INFILE2, 
OUTPUT OUTFILE1,OUTFILE2, PRINTFILE, 
INITIALIZE FILE-COUNTERS, JIM-COUNTERS, RATECODE-TABLE , NAVET-TABLE. 
MOVE SPACES TO OUTREC1,OUTREC2. 
PERFORM SOO-READ-FILE2. 


-: vor? 
"FLAS 


300-READ-FILE2. 
READ INFILE2 
AT END MOVE 1 TO EOF2. 
IF (EOF2 NOT = 1) 
MOVE RCODE TO RCODE-T 
ADD 1 TO INCNT2. 


325-SETUP-RATE-TABLE. 
PERFORM 350-READ-INFILE. 
MOVE 1 TO PTR. 
PERFORM 375-READ-IN-DATA-FOR-TABLE 
UNTIL (EOF = 1). 
CLOSE INFILE. 
MOVE 70 TO RATE-NUM(129) ‘ 
MOVE 9909 TO RATECODE(129). : 
MOVE ‘OTH’ TO ALPHA-RATE(70). : 
: 


PPA AEA TRY st 


350-READ-INFILE. 
READ INFILE : 
AT END MOVE 1 TO EOF. 


375-READ-IN-DATA-FOR-TABLE. 4 
ADD 1 TO INCNT. o 
MOVE RATECODE-IN TO RATECODE( PTR). , “ 


MOVE RATE-NUM-IN TO RATE-NUM( PTR). Z 
MOVE RATE-NUM-IN TO RATE-NUM-IN-T : 
IF (ALPHA-RATE(RATE-NUM-IN-T) = " a) " 


MOVE ALPHA-RATE-IN TO ALPHA-RATE(RATE-NUM-IN-T). ; 
PERFORM 350-READ-INFILE. ‘ 
ADD 1 TO PTR. . 


400-MAIN-FILE-LOGIC. 5 
IF (YEAR-FLAG(10)=1) : 
PERFORM 500-GET-GAIN-YR 

ADD 1. TO TOTAL : 
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SEARCH ALL RATECODE-DATA 
AT END PERFORM 
ADD 1 TO INV(RATE-NUM(129),LOS) 
SET R-INDX TO 129 
END- PERFORM 
WHEN (RATECODE(R-INDX) = RCODE-T) 
ADD 1 TO INV(RATE-NUM(R-INDX),LOS) 
END-SEARCH 
IF (R-INDX=129) AND (D-CNT « 100) 
DISPLAY INREC2 
ADD 1 TO D-CNT 
END-IF 
ELSE 
ADD 1 TO NO-MATCH. 


PERFORM 3O0-READ-FILE2. 


500-GET-GAIN-YR. 
MOVE 1 TO DONE 
MOVE 9 TO YEAR 
PERFORM UNTIL (DONE=0) 
IF (YEAR=0) 
MOVE O TO DONE 
ELSE 
IF (YEAR-FLAG( YEAR) =0) 
MOVE O TO DONE 
END-IF 
END-IF 
SUBTRACT 1 FROM YEAR 
END~PERFORM. 
IF (YEAR=~1) 
MOVE 75 TO GAIN-YEAR 
MOVE 10 TO LOS 
ELSE 
ADD 75 2 YEAR GIVING GAIN-YEAR 
SUBTRACT YEAR FROM 9 GIVING LOS. 
IF (LOS>8) 
MOVE 8 TO LOS. 


700-WRITE-LONGIT. 
MOVE INREC2 TO OUTREC1. 
WRITE OUTREC1. 
ADD 1 TO OUTCNT1. 


1000-TERMINATION. 
PERFORM 1200-WRITE-TABLE. 
PERFORM 1100-WRITE-RESULTS. 


CLOSE INFILE2, OUTFILE1,OUTFILE2, PRINTFILE. 
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1100-WRITE-RESULTS. 
MOVE "NUMBER OF OTHERS IN ‘85 INVENTORY" TO VAR-LABEL. 
MOVE TOTAL TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT AFTER 2 LINES. 
MOVE "NUMBER OF NON-85 OTHERS" TO VAR-LABEL. 
MOVE NO-MATCH TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT. 

MOVE "NUMBER OF INFILE2 RECORDS" TO VAR-LABEL. 
MOVE INCNT2 TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT . 

MOVE “NUMBER OF OUTFILE1 RECORDS " TO VAR-LABEL. 
MOVE OUTCNT1 TO VAR-NUMBER. 
WRITE PRINTLINE FROM STATEMENT. 


1200-WRITE-TABLE. 
MOVE "“APG/OSVET INVENTORY" TO VAR-LABEL. 
MOVE O TO VAR-NUMBER. 
WRITE OUTREC2 FROM STATEMENT AFTER 2 LINES. 
MOVE SPACES TO OUTREC2. 
PERFORM VARYING RNUM FROM 1 BY 1 UNTIL (RNUM>70) 
MOVE ALPHA-RATE(RNUM) TO RATING-OUT 
PERFORM VARYING LOS FROM 1 BY 1 UNTIL (LOS>8) 
MOVE INV(RNUM,LOS) TO INV-OUT(LOS) 
END- PERFORM 
WRITE OUTREC2 
END- PERFORM. 
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IDENTIFICATION DIVISION. 


PROGRAM-ID. INV84-AGG. 
AUTHOR. Jd GROGAN. 
INSTALLATION. CNA. 
DATE-WRITTEN. 11/06/86. 
DATE-COMPILED. 

SECURITY. UNCLASSIFIED. 


ENVIRONMENT DIVISION. 
CONFIGURATION SECTION. 
SOURCE-COMPUTER. VAX-11-780. 
OBJECT-COMPUTER. VAX-11-780. 


INPUT-OUTPUT SECTION. 
FILE-CONTROL. 


SELECT INFILE ASSIGN TO IFILE. 
SELECT INFILE1 ASSIGN TO IFILE1. 
SELECT INFILE2 ASSIGN TO IFILE2. 
SELECT OUTFILE1 ASSIGN TO OFILE1. 
SELECT OUTFILE2 ASSIGN TO OFILE2. 
SELECT PRINTFILE ASSIGN TO PFILE. 


DATA DIVISION. 
FILE SECTION. 


FD 


01 


FD 


01 


FD 


01 


INFILE 
RECORD CONTAINS 14 CHARACTERS 
DATA RECORD IS INREC. 


INREC. 

05 FILLER PIC X. 

05 RATE-NUM-IN PIC S(5)+ 
O05 FILLER PIC X(2). 
05 ALPHA-RATE-IN PIC X(3). 
O05 FILLER PIC E(1). 
O05 RATECODE-IN PIC 9(4). 
INFILE1 


RECORD CONTAINS 22 CHARACTERS 
DATA RECORD IS INREG1. 


INREC1. 
O05 SAM-SSN PIC 9(9). 
O05 FILLER PIC EC): 
05 GAIN-DATE PIC 9(4). 
05 FILLER PIC X(2). 
INFILE2 


RECORD CONTAINS 86 CHARACTERS 
DATA RECORD IS INREC2. 


INREC2. 
O5 SSN PIC X(9). 
05 YEAR-FLAG OCCURS 11 TIMES 

PIC 9(1). 
OS FILLER PIC K(54). 
05 RCODE PIC 2(3)9. 
05 FILLER PIC X(8). 

C-48 


el a i 


oe OC me a oe Se) Bt Ne ae on oe De ee eee ae Se oe ee OT 


mt. 


~—e eae 


«tate 


i a ee | ee aa oe er! 


Palm NV ry tL, 


we @_ wee _ He 


FTN a be a I UN a A PL TT Path tts tad 


PUA SUP WP a oe eee ee a 


. 


FD 


Ol 


FD 


Ol 


FD 


Ol 


OUTFILE1 
RECORD CONTAINS 86 CHARACTERS 
DATA RECORD IS OUTREC1. 


OUTREC1. 
05 FILLER PIC X(86). 
OUTFILE2 

RECORD CONTAINS 51 CHAXACTERS 
DATA RECORD IS OUTREC2. 


OUTREC2. 
05 RATING-OUT 
05 LOS-DATA OCCURS 8 TIMES. 


PIC X(3). 


10 FILLER PIe-z(2). 
10 INV-OUT PIC 9(4). 
PRINTFILE 


DATA RECORD IS PRINTLINE. 


PRINTLINE PIC X(80). 


WORKING-STORAGE SECTION. 


O01 


Ol 


Ol 


FILE-COUNTERS. 


O05 PARCNT PIC 9(4) USAGE 
O05 EOF PIC 9(1) USAGE 
05 EOF1 PIC 9(1) USAGE 
O5 EOF2 PIC 9(1) USAGE 
05 INCNT PIC 9(6) USAGE 
05 INCNT1 PIC 9(6) USAGE 
05 INCNT2 PIC 9(6) USAGE 
05 OUTCNT1 PIC 9(6) USAGE 
05 OUTCNT2 PIC 9(6) USAGE 
STATEMENT. 

05 VAR-LABEL PIC K(35). 

O05 VAR-NUMBER-1 PIC 2(1)9(1). 

05 VAR-NUMBER PIC 2(9)9(1). 
JIM-COUNTERS. 

O05 TEMP PIC 9(6). 

05 TOTAL PIC 9(7) USAGE COMP. 
05 MATCHED PIC 9(7) USAGE COMP. 
05 MATCHES-85 PIC 9(7) USAGE COMP. 
O05 PTR PIC 9(3). 

05 RATE-NUM-IN-T PIC 9(3). 

05 RCODE-T PIC 9(4). 

O05 YEAR PIC S9(2). 

05 YEAR-1 PIC 9(2). 

O05 CHG-CNT PIC 9(6) USAGE COMP. 
05 RNUM PIC 9(3). 

05 PROG PIC 9(1). 

05 GAIN-YEAR PIC 9(2). 

05 LOS PIC 9(2). 

05 DONE PIC 9(1). 

05 D-CNT PIC 9(6) USAGE COMP. 
05 TOTAL-84 PIC 9(6) USAGE COMP. 
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PROCEDURE DIVISION. a 
DECLARATIVES. 
IOERROR SECTION. 


PARITY-ACTION. 


END DECLARATIVES. 
MAIN SECTION. 


OVERALL-STRUCTURE. 


EXIT-OVER-STRUCTURE. 


100-BEGINNING. 


200-READ-FILE1. 


SOO-READ-FILE2. 


WT Wie ie Ls OY AU Ae he ek ee an 


RATECODE-TABLE. 

O05 RATECODE-DATA OCCURS 129 TIMES 
ASCENDING KEY IS RATECODE 
INDEXED BY R-INDX. 


10 RATE-NUM PIC 9(3); 
10 RATECODE PIC 9(4). 
10 ALPHA-RATE PIC X(3). 


NAVET-TABLE. 
O05 NAVET-RATE OCCURS 70 TIMES. ’ 
10 INV OCCURS 8 TIMES PIC 9(4). 


USE AFTER ERROR PROCEDURE ON iNFILE. 


ADD 1 TO PARCNT. 

IF (PARCNT » 2000) 
DISPLAY “ ABORTING FROM DECLARATIVES SECTION. 
STOP RUN. 


PERFORM 100-BEGINNING. 
PERFORM 325-SETUP-RATE-TABLE. 
PERFORM 400-MAIN-FILE-LOGIC 

UNTIL (EOF1 = 1) OR (EOF2 = 1). 
PERFORM 1000-TERMINATION. 
STOP RUN. 


EXIT. 


OPEN INPUT INFILE, INFILE1,INFILE2, 
OUTPUT OUTFILE1,OUTFILE2, PRINTFILE, 
INITIALIZE FILE-COUNTERS, JIM-COUNTERS, RATECODE-TABLE, NAVET-TABLE. 
MOVE SPACES TO OUTREC1,OUTREC2. 
PERFORM 200-READ-FILE1. 
PERFORM 300-READ-FILE2. 


READ INFILE1 

AL END MOVE: I ‘TO. BOF 1.. 
IF (EOF1 NOT = 1) 

ADD 1 TO INCNT1.. 


READ INFILE2 
AT END MOVE 1 TO EOF2. 
IF (EOF2 NOT = 1) 
MOVE RCODE TO RCODE-T 
ADD 1 TO INCNT2. 
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325-SETUP-RATE-TABLE. 
PERFORM 350-READ-INFILE. 
MOVE 1 TO PTR. 
PERFORM 375-READ-IN--DATA-FOR-TABLE 
; UNTIL: CEOF = 1). 
, CLOSE INFILE. 
MOVE 70 TO RATE-NUM(129) 
MOVE 9909 TO RATECODE(129). 
MOVE ‘OTH’ TO ALPHA-RATE(70). 


ae ee ey 


‘e 

cy a 

350-READ-INFILE. 

} READ INFILE 

i . AT END MOVE 1 TO EOF. 


375-READ-IN-DATA-FOR-TABLE. 
ADD 1 TO INCNT. 
MOVE RATECODE-IN TO RATECODE( PTR). 
MOVE RATE-NUM-IN TO RATE-NUM(PTR). 
MOVE RATE-NUM-IN TO RATE-NUM-IN-T 
IF (ALPHA-RATE(RATE-NUM-IN-T) = " eS 
MOVE ALPHA-RATE-IN TO ALPHA-RATE(RATE-NUM-IN-T). 
PERFORM 350-READ-INFILE. 
ADD 1 TO PTR. 


a F 


400-MAIN-FILE-LOGIC. 
IF ( SAM-SSN « SSN ) 
PERFORM 200-READ-FILE1 
ELSE 
IF (SAM-SSN = SSN ) 
ADD 1 TO MATCHED 
IF (YEAR-FLAG(9)=1) 
ADD 1 TO TOTAL-84 
END-IF 
. IF (YEAR-FLAG(10)=1) 
PERFORM 500-GET-GAIN-YR 
ADD 1 TO TOTAL 
SEARCH ALL RATECODE-DATA 
AT END PERFORM 
ADD 1 TO INV(RATE-NUM(129),LOS) 
SET R-INDX TO 129 
END- PERFORM 
WHEN (RATECODE(R-INDX) = RCODE-T) 
ADD 1 TO INV(RATE-NUM(R-INDX),LOS) 
END-SEARCH 
IF (R-INDX=129) AND (D-CNT « 100) 
DISPLAY INREC2 
ADD 1 TO D-CNT 
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« 


END-IF 
ELSE 
PERFORM 700-WRITE-LONGIT 
END-IF 
PERFORM 200-READ-FILE1 
‘ PERFORM 3SO00-READ-FILE2 
; ELSE 
‘ NAV-SSN > SSN 


PERFORM 7O0-WRITE-LONGIT 
PERFORM SOO-READ-FILE@2. 
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IF (EOF1=1) 

PERFORM UNTIL (EOF2=1) 
PERFORM 7OO-WRITE-LONGIT 
PERFORM S00-READ-FILE2 

END- PERFORM. 


5OO-GET-GAIN-YR. 
* cheating, we are only using FY'84,FY'85 data... 
MOVE 1 TO DONE 
MOVE 9 TO YEAR 
PERFORM UNTIL (DONE=0) 
IF (YEAR=0) 
MOVE 0 TO DONE 
ELSE 
IF (YEAR-FLAG( YEAR )=0) 
MOVE O TO DONE 
END-IF 
END-IF 
SUBTRACT 1 FROM YEAR 
END- PERFORM. 
IF (YEAR=-1) 
MOVE 75 TO GAIN-YEAR 
MOVE 10 TO LOS 
ELSE 
ADD 75 2 YEAR GIVING GAIN-YEAR 
SUBTRACT YEAR FRCM 9 GIVING LOS. 
IF (LOS>8) 
MOVE 8 TO LOS. 


700-WRITE-LONGIT. 
MOVE INREC2 TO OUTREC1. 
WRITE OUTREC1. 
ADD 1 TO OUTCNT1. 


1O00-TERMINATION. 
PERFORM 1200-WRITE-TABLE. 
PERFORM 1100-WRITE-RESULTS. 
CLOSE INFILE1, INFILE2, OUTFILE1,OUYFILE2, PRINTFILE. 


1100-WRITE-RESULTS. 

MOVE "MATCHES WITH '84 SAMS" TO VAR-LABEL 
MOVE TOTAL-84 TO VAR-NUMBER 

WRITE PRINTLINE FROM STATEMENT AFTER 2 LINES. 
MOVE "NUMBER OF SAMS IN INVENTORY" TO VAR-LABEL. 
MOVE TOTAL TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT . 
MOVE "TOTAL NUMBER OF SAM MATCHES" TO VAR-LABEL. 
MOVE MATCHED TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT. 
MOVE "NUMBER OF INFILE1 RECORDS" TO VAR-LABEL. 
MOVE INCNT1 TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT . 
MOVE "NUMBER OF INFILE2 RECORDS" TO VAR-LABEL. 
MOVE INCNT2 TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT . 
MOVE “NUMBER OF OUTFILE1 RECORDS " TO VAR-LABEL. 
MOVE OUTCNT1 TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT. 
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1200-WRITE-TABLE. 
MOVE “SAM INVENTORY" TO VAR-LABEL. 
MOVE TEMP TO VAR-NUMBER. 
WRITE OUTREC2 FROM STATEMENT AFTER 2 LINES. 
MOVE SPACES TO OUTREC2. 
PERFORM VARYING RNUM FROM 1 BY 1 UNTIL (RNUM>70) 
MOVE ALPHA-RATE(RNUM) TO RATING-OUT 
PERFORM VARYING LOS FROM 1 BY 1 UNTIL (LOS>8) 
MOVE INV(RNUM,LOS) TO INV-OUT(LOS) 
END- PERFORM 
WRITE OUTREC2 
END-PERFORM. 
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IDENTIFICATION DIVISION. 


PROGRAM-ID. INV84-AGG. 
AUTHOR. J GROGAN. 
INSTALLATION. CNA. 
DATE-WRITTEN. 11/06/86. 
DATE-COMPILED. 

SECURITY. UNCLASSIFIED. 


ENVIRONMENT DIVISION. 
CONFIGURATION SECTION. 
SOURCE-COMPUTER. VAX-11-780. 
OBJECT-COMPUTER. VAX-11-780. 


INPUT-OUTPUT SECTION. 
FILE-CONTROL. 


2O IFILE. 
<0 TF LGEL . 
TO IFILE2. 
TO OFILE1. 
TO OFILE2. 
TO PRILE. 


PIC X. 
PIC 2(3). 
PIC X(2). 
PIC xX(3). 
PIC X(1). 
PIC 9(4). 


SELECT INFILE ASSIGN 
SELECT INFILE1 ASSIGN 
SELECT INFILE2 ASSIGN 
SELECT OUTFILE1 ASSIGN 
SELECT OUTFILE2 ASSIGN 
SELECT PRINTFILE ASSIGN 
DATA DIVISION. 
FILE SECTION. 
FD INFILE 
RECORD CONTAINS 14 CHARACTERS 
DATA RECORD IS INREC. 
Ol INREC. 
05 FILLER 
O05 RATE-NUM-IN 
05 FILLER 
05 ALPHA~RATE-IN 
05 FILLER 
05 RATECODE-IN 
FD INFILE1 
RECORD CONTAINS 30 CHARACTERS 
DATA RECORD IS INREC1. 
Ol INREC1. 
O05 NAV-SSN PIC 9(9). 
05 LOSS-DATE PIC 9(4). 
O05 FILLER PIC X(5). 
05 E-PROGRAM PIC 9(3). 
O05 FILLER PIC X(9). 
FD INFILE2 
RECORD CONTAINS 86 CHARACTERS 
DATA RECORD IS INREC2. 
O01 INREC2. 
05 SSN PIC X(9). 
O05 YEAR-FLAG OCCURS 11 TIMES 
PIC 9(1). 
O05 FILLER PIC X(54). 
O05 RCODE PIC 2(3)9. 
O05 FILLER PIC X(8). 
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OUTFILE1 
RECORD CONTAINS 86 CHARACTERS 
DATA RECORD IS OUTREC1. 


OUTREC1. 


OS 


FILLER PIC X(86). 


OUTFILE2 
RECORD CONTAINS 51 CHARACTERS 
DATA RECORD IS OUTREC2. 


OUTREC2. 
O05 RATING-OUT PIC Z(3) : 
O05 LOS-DATA OCCURS 8 TIMES. 
10 FILLER PIC X(2). 
10 INV-OUT PIC 9(4). 
PRINTFILE 
DATA RECORD IS PRINTLINE. 
PRINTLINE PIC X80). 


WORKING-STORAGE SECTION. 


01 


Ol 


Ol 


FILE-COUNTERS . 


OS PARCNT PIC 9(4) USAGE 
OS EOF PIC 9(1) USAGE 
O05 EOF PIC 9(1) USAGE 
O05 EOF2 PIC 9(1) USAGE 
05 INCNT PIC 9(6) USAGE 
O05 INCNT1 PIC 9(6) USAGE 
O05 INCNT2 PIC 9(6) USAGE 
O05 OUTCNT1 PIC 9(6) USAGE 
05 OUTCNT2 PIC 9(6) USAGE 
STATEMENT. 

O05 VAR-LABEL PIC X(35). 

O05 VAR-NUMBER-1 PIC 2(1)9(1). 

05 VAR-NUMBER PIC 2(9)9(1). 
JIM-COUNTERS. 

OS TEMP PIC 9(6). 

O05 TOTAL PIC 9(7) USAGE COMP. 
O05 MATCHED PIC 9(7) USAGE COMP. 
O05 MATCHES-85 PIC 9(7) USAGE COMP. 
O05 PTR PIC 9(3). 

OS RATE-NUM-IN-T PIC 9(3). 

05 R8CODE-T PIC 9(4). 

O05 YEAR PIC s9(2). 

O05 YEAR-1 PIC 9(2). 

05 CHG-CNT PIC 9(6) USAGE COMP. 
O05 RNUM PIC 9(3). 

05 PROG PIC 9(1). 

O05 GAIN-YEAR PIC 9(2). 

05 LOS PIC 9(2). 

O05 DONE PIC 9(1). 

O05 NAVET PIC 9(1). 

05 D-CNT PIC 9(6) USAGE COMP. 
O5 PROG-2-CNT PIC 9(6) USAGE COMP. 
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Ol OTHER-COUNTERS. 
O5 UPPER. 
10 UPPER-YR PIC 9(2). 
10 UPPER-MO PIC 9(2) VALUE IS Q. 
O5 LOWER. 
10 LOWER-YR PIC 9(2). 
10 LOWER-MO PIC 9(2) VALUE IS 10. 


Ol RATECODE-TABLE. 
OS RATECODE-DATA OCCURS 129 TIMES 
ASCENDING KEY IS RATECODE 
INDEXED BY R-INDX. 


10 RATE-NUM PIC 9(3). 
10 RATECODE PIC 9(4). 
10 ALPHA-RATE PIC 23). 


O01 NAVET-TABLE. 
O05 NAVET-RATE OCCURS 70 TIMES. 
10 PROGRAM-DATA OCCURS 2 TIMES. 
15 INV OCCURS 8 TIMES PIC 9(4). 


PROCEDURE DIVISION. 
DECLARATIVES. 
IOERROR SECTION. 
USE AFTER ERROR PROCEDURE ON INFILE. 
PARITY-ACTION. 
ADD 1 TO PARCNT. 
IF (PARCNT » 2000) 
DISPLAY " ABORTING FROM DECLARATIVES SECTION. " 
STOP RUN. 
END DECLARATIVES. 


MAIN SECTION. 


OVERALL-STRUCTURE. 
PERFORM 100-BEGINNING. 
PERFORM 325-SETUP-RATE-TABLE. 
PERFORM 400-MAIN-FILE-LOGIC 
UNTIL (EOF1 = 1) OR CEOF2 = 1). 
PERFORM 1000-TERMINATION. 
STOP RUN. 
EXIT-OVER-STRUCTURE. 
EXIT. 


100-BEGINNING. 
OPEN INPUT INFILE, INFILE1,INFILE2, 
OUTPUT OUTFILE1,OUTFILE2, PRINTFILE, 


INITIALIZE FILE-COUNTERS, JIM-COUNTERS, RATECODE-TABLE , NAVET-TABLE. 


MOVE SPACES TO OUTREC1,OUTREC2. 
PERFORM 200-READ-FILE1. 
PERFORM 300-READ-FILE2. 


200-READ-FILE1. 


PERFORM 210-READ-FILE1. 
PERFORM 210-READ-FILE1 UNTIL (LOSS-DATE>7809) OR (EOF1l=1). 
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210-READ-FILE1. 2 


READ INFILE1 ; 

AT END MOVE 1 TO EOF1l. S 

IF (EOF1 NOT = 1) et 

ADD 1 TO INCNT1. re 

I 

300-READ-FILE2. 3 


READ INFILE2 
AT END MOVE 1 TO EOF2. te 
IF (EOF2 NOT = 1) S 
MOVE RCODE TO RCODE-T 2 
ADD 1 TO INCNT2. : 


r 
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325-SETUP-RATE-TABLE. 
PERFORM 350-READ-INFILE. 
MOVE 1 TO PTR. 
PERFORM 375-READ-IN-DATA-FOR-TABLE 
UNTIL CEOP = 1), 
CLOSE INFILE. 
MOVE 70 TO RATE-NUM(129) 
MOVE 9909 TO RATECODE(129). 
MOVE ‘OTH’ TO ALPHA-RATE(70). 


‘ 
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350-R#ZAD-INFILE. 
READ INFILE 
AT END MOVE 1 TO EOF. 


375-READ-IN-DATA-FOR-TABLE. 
ADD 1 TO INCNT. 
MOVE RATECODE-IN TO RATECODE( PTR). 
MOVE RATE-NUM-IN TO RATE-NUM( PTR). 
MOVE RATE-NUM-IN TO RATE-NUM-IN-T 
IF (ALPHA-RATE(RATE-NUM-IN-T) = " 1) 
MOVE ALPHA-RATE-IN TO ALPHA-RATE(RATE-NUM-IN-T). 
PERFORM 350-READ-INFILE. 
ADD 1 TO PTR. 
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400-MAIN-FILE-LOGIC. 
IF ( NAV-SSN « SSN ) 
PERFORM 200-READ-FILE1 
ELSE 
IF (NAV-SSN = SSN ) : 
ADD 1 TO MATCHED ) 
IF (YEAR-FLAG(10)=1) 
ADD 1 TO MATCHES-85 
PERFORM 500-GET-GAIN-YR 
PERFORM 600-COMPARE-DATE 
IF (NAVET=1) 
IF (E-PROGRAM=2 ) , 
MOVE 2 TO PROG 
ADD 1 TO PROG-2-CNT 
ELSE 
MOVE 1 TO PROG 
END-IF 
ADD 1 TO TOTAL 
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SEARCH ALL RATECODE-DATA 
AT END PERFORM 
ADD 1 TO INV(RATE-NUM(129), PROG, LOS) 
SET R-INDX TO 129 
END- PERFORM 
WHEN (RATECODE(R-INDX) = RCODE-T) 
ADD 1 TO INV(RATE-NUM(R-INDX), PROG, LOS) 
END-SEARCH 
IF (R-INDX=129) AND (D-CNT « 100) 
DISPLAY INREC2 
ADD 1 TO D-CNT 


END-IF 
ELSE 
PERFORM 7O0O-WRITE-LONGIT 
END-I? 
ELSE 
PERFORM 700-WRITE-LONGIT 
END-IF 
PERFORM 200-READ-FILE1 
PERFORM 3OO-READ-FILE2 
ELSE 
NAV-SSN > SSN 


PERFORM 700-WRITE-LONGIT 
PERFORM 3OO-READ-FILE2. 


IF (EOF1 


=1) 


PERFORM UNTIL (EOF2=1) 
PERFORM 700-WRITE-LONGIT 
PERFORM 300-READ-FILE2 

END-PERFORM. 


500-GET-GAIN-YR. 
MOVE 1 TO DONE 
MOVE 9 TO YEAR 


PERFORM 


UNTIL (DONE=0) 


IF (YEAR=0) 
MOVE O TO DONE 


ELSE 
oF C 


YEAR-FLAG( YEAR) =0 ) 


MOVE O TO DONE 
END-IF 

END-IF 

SUBTRACT 1 FROM YEAR 
END- PERFORM. 
IF (YEAR=-1) 

MOVE 75 TO GAIN-YEAR 

MOVE 10 TO LOS 


ELSE 


ADD 75 2 YEAR GIVING GAIN-YEAR 
SUBTRACT YEAR FROM 9 GIVING LOS. 


IF (LOS> 


8) 


MOVE 8 TO LOS. 
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600-COMPARE-DATE. 


MOVE GAIN-YEAR TO UPPER-YR. 
SUBTRACT 2 FROM UPPER-YR GIVING LOWER-YR. 
IF (LOWER-YR<78) 
MOVE 78 TO LOWER-YR. 
IF (LOWER<LOSS-DATE) AND (LOSS-DATE< UPPER) 
MOVE 1 TO NAVET 
ELSE 
MOVE O TO NAVET. 


700-WRITE-LONGIT. 


MOVE INREC2 TO OUTREC1. 
WRITE OUTREC1. 
ADD 1 TO OUTCNT1. 


1000-TERMINATION. 


PERFORM 1200-WRITE-TABLE. 
PERFORM 1100-WRITE-RESULTS. 


CLOSE INFILE1, INFILE2, OUTFILE1,OUTFILE2, PRINTFILE. 


1100-WRITE-RESULTS. 


MOVE "NUMBER OF ACTIVE MARINERS" TO VAR-LABEL. 
MOVE PROG-2-CNT TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT. 

MOVE "NUMBER OF ‘85 RECENT NAVETS" TO VAR-LABEL. 
MOVE TOTAL TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT AFTER 2 LINES. 
MOVE "NUMBER OF ‘85 NAVET MATCHES" TO VAR-LABEL. 
MOVE MATCHES-85 TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT. 

MOVE "TOTAL NUMBER OF NAVET MATCHES" TO VAR-LABEL. 
MOVE MATCHED TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT. 

MOVE "NUMBER OF INFILE1 RECORDS" TO VAR-LABEL. 
MOVE INCNT1 TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT . 

MOVE "NUMBER OF INFILE2 RECORDS" TO VAR-LABEL. 
MOVE INCNT2 TO VAR-NUMBER. 

WRITE PRINTLINE FROM STATEMENT . 

MOVE "NUMBER OF OUTFILE1 RECORDS " TO VAR-LABEL. 
MOVE OUTCNT1 TO VAR-NUMBER. 
WRITE PRINTLINE FROM STATEMENT. 


1200-WRITE-TABLE. 


MOVE "4Y0,5/6Y0,PS,TAR INVENTORY” TO VAR-LABEL. 
MOVE TEMP TO VAR-NUMBER. 
WRITE OUTREC2 FROM STATEMENT AFTER 2 LINES. 
MOVE SPACES TO OUTREC2. 
PERFORM VARYING RNUM FROM 1 BY 1 UNTIL (RNUM>70) 
MOVE ALPHA-RATE(RNUM) TO RATING-OUT 
PERFORM VARYING LOS FROM 1 BY 1 UNTIL (LOS>8) 
MOVE INV(RNUM,1,LOS) TO INV-OUT(LOS) 
END- PERFORM 
WRITE OUTREC2 
END- PERFORM. 
MOVE "ACTIVE MARINER INVENTORY" TO VAR-LABEL. 
MOVE TEMP TO VAR-NUMBER. 
WRITE OUTREC2 FROM STATEMENT AFTER 2 LINES. 
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MOVE SPACES TO OUTREC2. 
PERFORM VARYING RNUM FROM 1 BY 1 UNTIL (RNUM>70) 
MOVE ALPHA-RATE(RNUM) TO RATING-OUT 
PERFORM VARYING LOS FROM 1 BY 1 UNTIL (LOS>8) 
MOVE INV(RNUM,2,LOS) TO INV-OUT(LOS) 
END- PERFORM 
WRITE OUTREC2 
END-PERFORM. 
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APPENDIX D 


SIMULATION PROGRAMS 


This appendix lists the annotated simulation programs that 


simulate future active and reserve enlisted inventories. 
in figure D-1 presents the logic of the simulation. 


The flow chart 
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ANNEX D-1 


LISTING OF COMMAND PROCEDURE TO EXECUTE SIMULATION PPOGRAMS 


cd 


Be i a Oe a Ok eR, a in a i in 


$ ASSIGN/USERMODE SYS$COMMAND SYS$INPUT 

$ DEFINE VT10@ SYS$SYSDEVICE: [VT‘ 20] 

$ OVT100:VT100 

$! 

$! 

$ ON CONTROL_Y THEN GOTO PLAY_IT_AGAIN 

$! 1 2 3 4 5 6 7 
$!123456789 123456789 123456789 123456789 123456789 123456789 123456789 12345678 
$! 

$ PLAY_IT_AGAIN: 

$! 

$ NORMAL 

$ CLEAR 

$! 

$ CURSOR 6 10 "1 - Execute Active simulation program" 
$ CURSOR 8 10 "2 - Execute Reserve simulation program" 
$ CURSOR 10 10 "3 - Execute program to compare two Active runs" 
$ CURSOR 12 10 "4 - Execute program to compare two Reserve runs" 
$ CURSOR 14 10 "9 - Finish this session" 

$ | 

$! 

$! 

$ MESSED_UP: 

$! 

$ CURSOR 161" " 

$ INQUIRE Xx ” Enter your selection” 

$! 

$! 

$ IF XX .£Q. 9 THEN GOTO ENDIT 

$ IF XX .EQ. 1 THEN GOTO RUN_ACTIVE 

$ IF XX .EQ. 2 THEN GOTO RUN_RESERVE 

$ IF XX .£€Q. 3 THEN GOTO RUN_COMPARE_ACTIVE 

$ IF XX .EQ. 4 THEN GOTO RUN_COMPARE_RESERVE 

$! 

$! 

$ GOTO MESSED_UP 

$! 

$! 

$! 

$! 

$ RUN_ACTIVE: 

$! RUN CNA2:[CORLISSG.FORCEJACTIVE 

$ RUN CNA2:[CORLISSG.FORCE.NEWJACTIVE 

$ GOTO PLAY_IT_AGAIN 

$! 

$! 

$! 

$ RUN_RESERVE: 

$ RUN CNA2:[CORLISSG. FORCE ]RESERVE 

$ GOTO PLAY_IT_AGAIN 

$! 

$! 

$! 

$ RUN_COMPARE_ACTIVE: 

$ RUN CNA2:[CORLISSG. FORCE JCOMPARE_A 

$ GOTO PLAY_IT_AGAIN 

$! 
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$! 
$! 

$ RUN_COMPARE_RESERVE: 
$ RUN CNA2:[CORLISSG. FORCE ]COMPARE_R 
$ GOTO PLAY_IT_AGAIN 
$! 

$! 

$! 

$! 

$ ENDIT: 

$! 

$ CLEAR 

$! 

$ STOP 
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ANNEX D-2 


; LISTING OF ACTIVE-DUTY SIMULATION PROGRAM 
| (VAX-11 FORTRAN) 
| 
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This program is designed to accept numbers from the terminal for 
total recruits, and then use historical continuation behaivor to 
transition the inventory. Variables used are: 


ACCESS(OUTY) This matrix is used to store the numbers 
input for Total Accessions for each of 
the outyears. 


CHANGED(OUTY, RATE) This matrix is used to store the 
ratings the user has changed for any 
of the outyears. 


NUM_C (OUTY) This matrix holds the counts for the 
number of ratings changed by the user 
for each of the outyears. 


CNT This counter is used for calculating 
how many zeros to DATA out in the SUM 
array. 

ALLOC(20,RATE+1,PROG+1) This motrix is read into the program 


and it stores the PRIDE allocations. 


LOS_1(OUTY,RATE+1 , PROG+1) This matrix stores the original 
allocation of outyears total recruits 
before any chonges hove been made. 
This matrix is really onty used in the 
WRITEOUT subroutine. 


LOS_1_C(OUTY,RATE+1,PROG+1) This matrix stores the original 
allocation of outyear recruits after 
the user has made changes in the rating 
or program mixes. 


N-D(LOS-2,RATE,PROG) This matrix is read into the program 
and it stores the percents used to 
calculate how many people to add back 


into a los,rating,prog cell that is 
growing. 
TRANS (LOS-2, RATE, PROG) This matrix is read into the program 


and it stores the continuation rates 
selected by the user to be applied to 
the history. It is capped at 1.0 


OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1) This matrix is where all the numbers 
that the simulation produces are stored. 
The first two positions in the outyear 
dimension are filied with history which 
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is read into the program. 


SUM(OUTY,RATE,PAYG) This is the matrix used to compare to 
requirments in the WRITEOUT procedure. 
It is computed by collapsing the 
OUTYEAR matrix down and adding PAYGRADE. 


The INCLUDE for Screen_Parameters contains the variables 
used for the screen handling subroutines. They ore: 


BE = ‘BE’ used to sound the bel! 


BL = °BL’ used to make the screen blink 

BO = *80’ used to make ‘he screen bold 

CL = ‘CL’ used for clearing the screen 

NE = ’NE’ used to make the screen negative 

NO = 'NO' used to set screen back to normal 

SC = 'SC’ used to score (underline) data on screen 
SK = ' ‘ used to skip an option. 


INCLUDE ‘CNA2:[CORLISSG.FORCE}]SCREEN_PARAMETERS. FOR’ 


ee et a ee ee ene ee en ee ae a ee ee ee a ee ee 8 a ee ee ee ee ee 


The INCLUDE for Paorameters_Res.for contains the variables 


to show how the Arrays should be dimensioned. They are: 
LOS = 31 There are 31 LOS’s in the ACTIVES 
RATE = 69 There are 69 Ratings 
PROG = 7 There are 7 programs in the ACTIVES 
PAYG = 9 There are 9 paygrodes 
OUTY = 18 There are 10 outyears for this simulation 


INCLUDE ‘CNA2:[CORLISSG.FORCE]PARAMETERS. FOR’ 
INTEGER ACCESS(OUTY), CHANGED(OUTY,RATE), CNT, NUM_C(OUTY) 


REAL ALLOC(2@,RATE+1,PROG+1), LOS_1(OUTY,RATE+1 ,PROG+1), 


. LOS_1_C(OUTY,RATE+1,PROG+1), N_D(LOS-2,RATE,PROG), 
. OUTYEAR (OUTY+2, LOS, RATE+1,PROG+1), SUM(OUTY,RATE,PAYG), 
. TRANS(LOS-2,RATE,PROG), LOSSES(OUTY, RATE, PROG-3) 


PARAMETER(CNT#OUTY*RATE*PAYG) 
CHARACTER#1 HOLD 

CHARACTER*2 YR_SEL 

DATA SUM/CNT#@.@/, NUM_C/OUTY*@/ 


OPEN (UNIT=6,STATUS='OLD’ ,RECL=500) 
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CHANGE_SCREEN(CL,SK,SK) 

DISPLAY(1®0,15,’AC TIVE FORCE S IMULATION' 
.BO,SK,SK) 

DISPLAY(22,25, ‘Hit Return to Start Run’,SK,SK,SK) 

ACCEPT(22,49,HOLD,SK,SK,SK) 

ACCEPT_OUTYEAR_RECRUITS(ALLOC,ACCESS,OUTYEAR,LOS_1,LOS_1_C) 

CHECK_SCHOOL_SEATS(OUTYEAR) 

CHANGE_MIXES(ALLOC, OUTYEAR,NUM_C,CHANGED,LOS_1_C) 

CHECK_TO_SEE_IF_SAVE_NEW_ALLOC(LOS_1_C) 

TRANSISTION( ACCESS , OUTYEAR, LOSSES) 

ADD_PAYGRADE (OUTYEAR, SUM) 

WRITEIT(SUM,NUM_C,CHANGED, YR_SEL,LOS_1,LOS_1_C,LOSSES) 

CHANGE_SCREEN(CL,SK,SK) 

DISPLAY(1@,20,'Finish of Active Force Simulation’ ,80,SK,SK) 

DISPLAY(23,27, Hit Return to Finish',SK,SK,SK) 


ACCEPT(23,48,HOLD,SK,SK,SK) 
CHANGE_SCREEN(CL,SK,SK) 
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SUBROUTINE ACCEPT OUTYEAR RECRUITS 


This subroutine is set up to allow the user to input via the terminal 


the total number of new recruits for each outyear (up to 20). First 
the user will input the accessions minus Sea College, then the user , 
will be atlowed to input for Sea College recruits. The variables used 

are: 


ROW,!,J,K,L,START,FINISH 


ACCESS(OUTY) 


SEA_C(OUTY) 


FLAG 


INT, MA 


DIS_YEAR 


ALLOC(20,RATE+1,PROG+1 ) 


These variables are used as indexes 
into arrays, and for calcutating the 
position the cursor. on the 

screen. 


This array stores the total 
recruits minus Sea College. 


This array stores the total Sea 
College recruits input for each 
outyear. 


This variable is used to flag 
whether the user is inputing for 
Sea Coliege or for all other 
recruits. 


Used as integer number holders. 


Used for storing year to be displayed 
on the terminal so the user will know 
which year is being worked with. 


This matrix is read into the program 
in this subroutine and it stores how 
the LOS 1 recruits are to be broken 
out by rating and program. 


OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1) In this suboutine Outyear will be 


HIST_1(LOS,RATE+1,PROG+1 ) 


HIST_2(LOS,RATE+1, PROG+1 ) 


MAX(20,RATE+1,9) 


filled for LOS 1 in each of the outyears 
Also the first Two outyear dimensions 
will be filled with HISTORY which will 
be read in this subroutine. 


This matrix will store the yeaor-1 
history and is read into the program. 


This motrix will sture the year-2 

history and is read into the program. 

HIST_1, HIST_2 will be loaded into 

OUTYEAR. : 


This matrix is read into the program 
and stores the maximum number allowed 
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Cc for each rating for each of the 
c outyears. This matrix is used to flag 
Cc for the user the ratings which exceed 
Cc the school ptan. 
Cc 
Cc LOS_1(OUTY,RATE+1,PROG+1) This matrix will store the original 
Cc LOS 1 breakout after the user inputs 
a Cc the tota! recruits and they are 
. Cc altocoted. 
c 
Cc LOS_1_C(OUTY,RATE+1,PROG+1) This matrix wil! store the original 
. c LOS 1 breakout and any changes that 
Cc have been made. Equals LOS_1 after 
Cc this subroutine because no changes 
Cc yet. 
c 
GBS 22 Boa ee a ae EE ee oe ee cee ee ee eos ee ee eee os Sao ee eee ew escse 
SUBROUTINE ACCEPT_OUTYEAR_RECRUITS(ALLOC ,ACCESS,OUTYEAR,LOS_1, 
LOS_1_C) 
IMPLICIT NONE 
| INCLUDE 'CNA2:[CORLISSG.FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE ’CNA2:[CORLISSG. FORCE ]PARAMETERS. FOR’ 
| 
INTEGER ROW, I, J, K, L, START, FINISH, ACCESS(OUTY), 
SEA_C(OUTY), FLAG, INT, MA, DIS_YEAR, ANS 
! 

REAL ALLOC(2@,RATE+1,PROG+1), OUTYEAR(OUTY+2,L0S,RATE+1,PROG+1), 
MAX(2@,RATE+1,9), HIST_2(LOS,RATE+1 ,PROG+1), 
HIST_1(LOS,RATE+1,PROG+1), LOS_1(OUTY,RATE+1,PROG+1), 
LOS_1_C(OUTY, RATE+1,PROG+1) 

CHARACTER#*2 HOLD 

CHARACTER*8 RATE_LABEL 

CHARACTER*S5®@ FILEN 

CHARACTER®25 NAME 

C@Ssss 555 oo 2 22 oe eS ew es ee eet ree oa ee coc ee oe, 


C First thing to do is select the allocation matrix and 
C to read in the two history files, then load the history into OUTYEAR. 


OPEN(UNIT#59,READONLY , STATUS=@’OLD',FORM='UNFORMATTED', 
. FILE=’CNA2: [CORLISSG.FORCE.DAT]H_2.DAT') 
; READ(59) HIST_2 
: CLOSE(UNIT#=59) 


* FILE=’CNA2: [CORLISSG.FORCE.DATJHIST.DAT’) 
READ(59) HIST_1 
CLOSE(UNIT#=59) 


DO.1@ t=1,PROG 


’ 
' 
' 
! 
i 
! 
N 
OPEN(UNIT#59,READONLY,STATUS='OLD', FORM='UNFORMATTED’, 
l 
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DO 10 K=t, RATE 
DO 1@ J=1,LOS 
OUTYEAR(1,J,K,L) = HIST_2(u.K.L) 
1) OUTYEAR(2.J,K,L) = HIST_1(U,K,L) 


20 CONTINUE 
CALL CHANGE_SCREEN(CL,SK,SK) 
CALL DISPLAY(10,15,°1°,B0,SK,SK) 
CALL DISPLAY(1@,16,' - Use the default Allocation matrix’, 


. SK,SK,SK) 
CALL OISPLAY(12,15,'2',BO,SK,SK) 


CALL DISPLAY(12,16,’ - Select a user created Allocation matrix’, 


A SK ,SK,SK) 
CALL DISPLAY(15,20,'Enter your selection: ’,SK,SK,SK) 


30 CONTINUE 

CALL ACCEPT_INTEGER(15,42,ANS,1,B0,SC,SK) 
C dIf the default is used then assign the default filename to FILEN 
C But if the user wants to select an allocation he/she created then 
Cc 


call FINO_LFILE ond the filename will be passed back. 


IF(ANS .NE. 1 .AND. ANS .NE. 2) THEN 


CALL DISPLAY(15,45, Invalid input <Hit Return>’,BO,NE,BE) 


CALL ACCEPT(15,71,HOLD,SK,SK,S«K) 


CALL DISPLAY(15,45,' ",SK,SK,SK) 


GOTO 30 
ELSE IF (ANS .£Q. 1) THEN 
FILEN = 'CNA2: [CORLISSG.FORCE.DAT]NEW_ALLOC.DAT’ 


ELSE 
CALL FIND_FILE(FILEN) 
END IF 
Cae fe so once ee eee ae e Sat ele eee ee ee a nee een eee wees ees See ae 
C FINO_LFILE subroutine will pass back 'FLAG' in the FILEN if there were 
C no user created allocation to select from. If this happens the user 
C must select the default or will not pass this point. 
IF (FILEN .EQ. ‘FLAG’) THEN 
GOTO 208 
ENO IF 
G6 Sec eeesee oot sa Sa ee eee oa Seen eee eae eee a ee eee eee eee eee 


C Next open the file selected. 


OPEN (UNIT=#59,READONLY, STATUS=' OLD’ ,FORM=’UNFORMATTED',FILE=FILEN) 


READ(59) ALLOC 
CLOSE (UNIT#=59) 


C The FLAG is used to show wether inputing for Sea College or not. 
FLAG = @ 
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CONTINUE 
CALL CHANGE_SCREEN(CL,SK,SK) 


IF (FLAG .EQ. 8) THEN 
CALL DISPLAY(6,1,'Total Accessions',BO,NE,BL) 
CALL DISPLAY(7,1,’Minus Sea College’,BO,NE,.BL) 
ELSE 
CALL DISPLAY(6,1,’Inputs for’,BO,NE,BL) 
CALL DISPLAY(7,1,'Sea College’ ,BO,NE,BL) 
END IF 


DIS_YEAR = CFY 


ROW = 2 
I = 1 


CALL DISPLAY_INTEGER(ROW,19,1,2,B0,SK,SK) 


CALL DISPLAY(ROW,21,’ -— Current FY',SK,SK,SK) 

CALL DISPLAY(ROW,34,'° Total Recruits :',SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW,50,DIS_YEAR,4,SK,SK,SK) 

CALL DISPLAY(ROW, 56,’ *,BO,SC,SK) 


DO 5@ I1=#2,0UTY 
DIS_YEAR = DIS_YEAR + 1 


IF (OUTY .GT. 10) THEN 
ROW = ROW + 1 


ELSE 
ROW = ROW + 2 
ENO IF 
CALL DISPLAY_INTEGER(ROW,19,1,2,80,SK,SK) 
CALL DISPLAY(ROW,21,° - Outyear’,SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW,32,1-1,2,SK,SK,SK) 
CALL DISPLAY(ROW,34,’ Total Recruits :',SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW,58,01S_YEAR,4,SK,SK,SK) 
CALL DISPLAY(ROW,56,° *,BO,SC,SK) 
CONTINUE 


IF (OUTY .GT. 16) THEN 


ROW = 1 
ELSE 

ROW = 0 
END IF 
START = 1 


FINISH = OUTY 
CONTINUE 


DO 7@ I=START,FINISH 
IF (OUTY .GT. 1@) THEN 
ROW = ROW + 1 
ELSE 
ROW = ROW + 2 
END IF 


D-19 


ee xt 


«or we 
c 4 «a ea 


-IMPLAZ LASS SG BFL" 


a. rw no a ae 


> ew 2 ee 
a a 


a Oe ee de ie ee ie oe ee A 


a el ee ee 


See eeegee oe eee ak ce et 8 ree, 


78 


Cc 


IF (FLAG .£Q. @) THEN 

ACCESS(I) = @ 

CALL ACCEPT_INTEGER(ROW,56,ACCESS(1),6,B0,SC,SK) 
ELSE 

SEA_C(I) = @ 

CALL ACCEPT_INTEGER(ROW,56,SEA_C(1),6,B0,SC,SK) 
ENO IF 


CONTINUE 


CALL DISPLAY(22,14, Enter Number of Outyear to change or <Return>’ 


,SK,SK,SK) 


CALL ACCEPT_INTEGER(22,60,START,2,s30,SC, SK) 


IF ((START .GT. @) .AND. (START .LE. OUTY)) THEN 


Set FLAG = 


IF (OUTY .GT. 1@) THEN 
ROW = START 


ELSE 
ROW = (START - 1) « 2 
END IF 


FINISH = START 


GOTO 62 

ENO IF 
for inputing Sea College 

IF (FLAG .€Q. @) THEN 
FLAG = 1 
GOTO 428 

END IF 

6 oSSSweencse ol cose Sale ee Se Se ec eet eS See cee eee ee ee ea 
loops will take the inputed accessions and ailocate 


The 8@ 


The 90 


into OUTYEAR using ALLOC. 
DO 8@ K=1,PROG+1 


DO 8@ Jx1,RATE+1 
DO 8@ I1=3,O0UTY+2 
OUTYEAR(I,1,J3,K) = ACCESS(I-2) * ALLOC(I-2,JU,K) 


is used to update ACCESS, OUTYEAR matrixes with 


loop 
the new program Sea College. 
DO 98 123,0UTY+2 


ACCESS(I-2) = ACCESS(I-2) + SEA_C(I-2) 

OUTYEAR(I,1,1,6) = SEA_C(1I-2) * @.27 

OUTYEAR(I1,1,32,6) = SEA_C(I-2) * @.29 

OUTYEAR(I,1,61,6) = SEA_C(I-2) * 0.44 

OUTYEAR(1,1,1,8) = OUTYEAR(I,1,1,8) + OUTYEAR(1,1,1,6) 
OUTYEAR(I,1,32,8) = OUTYEAR(I,1,32,8) + OUTYEAR(I,1,32,6) 
OUTYEAR(I,1,61,8) = OUTYEAR(I,1,61,8) + OUTYEAR(I,1,32,6) 


OUTYEAR(I,1,7@,6) = OUTYEAR(I,1,70,6) + SEA_C(I-2) 
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90 OUTYEAR(1,1,7@,8) = OUTYEAR(I,1,78,8) + SEA_C(I-2) 
Cw----~~——- ~~ -- + + ++ +--+ ee ee ee 5 
C The 108 loop is used to fill up LOS_1 and LOS_1_C with OUTYEAR's 


C LOS 1 for each of the outyears. 
DO 100 I=1,0UTY 
DO 108 J=1,RATE+1 
DO 100 K=1,PROG+1 
LOS_1(1,J,K) = OUTYEAR(I+2,1,J3,K) 
100 LOS_1_C(I,J,K) = OUTYEAR(1+2,1,J,K) 


RETURN 
END 
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SUBROUTINE F IN OD FILE 


This subroutine is used to allow the user to select any previously 


created and saved allocation matrix. The subroutine searches the 
users directory for allocation files and displays to the terminal the 
choices. If no choices are available, ‘FLAG’ is put in FILEN. 

FILEN This is passed back to the main 


program ond it contains the filename 
of the users choice or ‘FLAG’. 


NEWFILE This is used in the library calt and 
it contains the next file found in the 
directory. When no more files it 
passes back the default filename. 


DEFAULT, RELATED, FILENAME These are used by the library and are 
used to locate a certain set of files. 


STORE(100) This is used to store the names of all 
the user created allocations found 
in the directory. 


DIS(10@) This stores the names of the files to 
be displayed to the user on the screen. 


CHECK Is used to check and see when there are 
no more files. 


CONTEXT Is used by the ltibrary subroutine as an 
address pointer and must be set to @ 
ot start. 

ROW, ROW! Used to calculate which row of the 


screen to display on. 


BEGIN, END Used to store the begin and end of 
strings that are being searched for in 
other strings. 


NUMFILES Is a counter used to keep count of the 
of altocations found in the directory. 


ANS The answer to which allocation the user 
selected to use. 


I, DIFF Used as integers for ftoops and 
calculations. 


SUBROUTINE FIND_FILE(FILEN) 


IMPLICIT NONE 
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INCLUDE 'CNA2:[CORLISSG. FORCE]SCREEN_PARAMETERS. FOR’ 
INTEGER CONTEXT, ROW, ROW1, BEGIN, ENO, NUMFILES, ANS, I, DIFF 


CHARACTER HOLD 


CHARACTER*5@ FILENAME, NEWFILE, DEFAULT, RELATED, FILEN, 
STORE(100), DIS(100), CHECK 


CALL CHANGE_SCREEN(CL.SK,SK) 
FILENAME = 'ZZZ_¢.DAT’ 


DEFAULT = FILENAME 
RELATED = FILENAME 


CONTEXT = @ 
NUMFILES = 1 


CHECK = ' 
CONTINUE 


CALL LIB$SFINO_FILE( FILENAME ,NEWFILE,CONTEXT,DEFAULT,RELATED) 


BEGIN = INDEX(NEWFILE,']ZZ2Z_') 
ENO = INDEX(NEWFILE,’ .OAT’) 
BEGIN = BEGIN + 1 

END = END + 3 

DIFF = (END — BEGIN) + 1 


CHECK(1:DIFF) = NEWFILE(BEGIN: END) 
DIS(NUMFILES) #= CHECK(5:DIFF-4) 


IF (CHECK .NE. FILENAME) THEN 
IF (NEWFILE .NE. STORE(NUMFILES)) THEN 
STORE(NUMFILES) = NEWFILE 
NUMFILES = NUMFILES + 1 
END IF 
CHECK = ° 
GOTO 18 
END IF 


NUMFILES = NUMFILES —- 1 


IF (NUMFILES .EQ. @) THEN 


CALL DISPLAY(1®,10,'No user created allocations yet <Hit Return>’ 


,BO,BE,SK) 
CALL ACCEPT(10,55,HOLD,SK,SK,SK) 
FILEN = *FLAG’ 
GOTO 999 
END IF 


ROW = 0 
ROW1 = Q 
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DO 20 I=1,NUMFILES 
IF (NUMFILES .GT. 18) THEN 
ROW = ROW + 1 
ELSE 
ROW = ROW + 2 
END IF 


IF (I .GT. 20) THEN 
ROW1 = ROW! + 1 
CALL DISPLAY_INTEGER(ROW1,46,1,3,B0,SK,SK) 
CALL DISPLAY(ROW1,50, °° ,SK,SK,SK) 
CALL OISPLAY(ROW1,.52,DIS(1),SK,.SK,SK) 


ELSE 
CALL DISPLAY_INTEGER(ROW,10,1,3,80,SK,SK) 
CALL DISPLAY(ROW,14,'~"°,SK,SK,SK) 
CALL DISPLAY(ROW,16,DIS(1),SK,SK,SK) 

END IF 


CONTINUE 
CALL DISPLAY(23,10,’Enter your selection: ',SK,SK,SK) 


CONTINUE 
CALL ACCEPT_INTEGER(23,32,ANS,2,B80,SC,SK) 


IF (ANS .LT. 1 .OR. ANS .GT. NUMFILES) THEN 
CALL DISPLAY(23,35,’ Invalid input <Hit Return>’,BO,NE,BE) 
CALL ACCEPT(23,62,HOLD,SK,SK,SK) 
CALL DISPLAY(23,35,’ >,SK,SK,SK) 
GOTO 38 

END IF 


FILEN = STORE(ANS) 
CONTINUE 


RETURN 
END 
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SUBROUTINE ewec kK SH OO & S EATS 


This subroutine is used to display to the user how the newly 
allocated new recruits are different from the planned school seat 


atlocations. 


This matrix has the Two history 
dimensions (1,2) of outyear 
filled in and the LOS 1 


OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1 ) 


dimension filled in for each 
outyeor. 
MAX(20,RATE+1 ,9) This matrix is read into the 


program in this subroutine 
and it contains the School 
plans for FY 1988. 


ROW, COLUMN Used to calc. where to display 
the number on the screen. 


I,J,K,L Used in loops. 


START, FINISH Used to show which ratings to 
display at the screen. 


INT, MA, DIFF, R Used as integers for 
calculating and storing 
numbers. 


SUBROUTINE CHECK_SCHOOL_SEATS(OUTYEAR) 
IMPLICIT NONE 


INCLUDE ‘CNA2: [CORLISSG. FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE 'CNA2:[CORLISSG.FORCEJPARAMETERS. FOR’ 


INTEGER ROW, COLUMN, I, J, K, L, INT, MA, START, FINISH, 
DIFF, R 


REAL OUTYEAR(OUTY+2,L0S,RATE+1,PROG+1), MAX(20,RATE+1,9) 
CHARACTER*1 HOLD, ANS 
CHARACTER*8& RATE_LABEL 


CHARACTER*5@ FILEN 
CHARACTER*25 NAME 


CALL CHANGE_SCREEN(CL,SK,SK) 


CALL DISPLAY(12,10,'Would you like to view the comparison of', 
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bd SK,SK,SK) 

CALL DISPLAY(13,10,’Allocations to Planned School Seats (', 
* SK,SK,SK) 

CALL DISPLAY(13,47,'Y’°,80,SK,SK) 

CALL DISPLAY(13,48,'es or’,SK,SK,SK) 

CALL DISPLAY(13,54,'°N’,80,SK,SK) 

CALL DISPLAY(13,55,'0)?’,SK,SK,SK) 

5 CONTINUE 

CALL ACCEPT(13,59,ANS,80,SC,SK) 

IF (ANS .NE. ’N’ .AND. ANS .NE. °Y’ AND. ANS .NE. ‘rn’ . AND. 
* ANS .NE. ‘y’) THEN 

GOTO 5 
END IF 


IF (ANS .£Q. "N’ .OR. ANS .EQ. ‘'n’) THEN 
GOTO 999 
END IF 


CALL CHANGE_SCREEN(CL,SK,SK) 


C The OUTYEAR motrix for LOS 1, the LOS 1 is 
C compared to the MAX array to see if it exceeds the school plan. 
C First read in MAX. 


OPEN (UNIT=59,READONLY,STATUS='OLD',FORM=’UNFORMATTED’, 
* FILE=’CNA2: (CORLISSG. FORCE.DATJMAX.DAT’) 

READ (59) MAX 

CLOSE (UNIT=59) 


ROW = @ 
COLUMN = 4 


START = 1 
FINISH = RATE 


DO 1@ I=START,FINISH 
ROW = ROW + 1 
IF (I .€Q. 24 .OR. I .£€Q. 47) THEN 
ROW = 1 
COLUMN = COLUMN + 25 
END IF 
INT = OUTYEAR(5,1,1,8) + .5 
MA = MAX(3,1,8) 
DIFF = INT — MA 
R = (OIFF / MAX(3,1,8)) * 100 
IF (MA .LT. INT) THEN 
CALL DISPLAY(ROW,COLUMN, ' ; 
* NE,SK,SK) 
CALL DISPLAY_INTEGER(ROW,COLUMN,DIFF,7,B80,NE,SK, 
CALL DISPLAY_INTEGER( ROW, COLUMN+8,R,3,80,NE,SK) 
CALL DISPLAY(ROW, COLUMN4+11,°%’ ,BO,NE,SK) 
CALL DISPLAY(ROW, COLUMN4+14,RATE_LABEL(I),NE,SK,SK) 
ELSE IF (MA .EQ. 999999) THEN 
CALL DISPLAY(ROW,COLUMN, ’No School Req’,80,SK,SK) 
CALL DISPLAY(ROW, COLUMN+14,RATE_LABEL(1),SK,SK,SK) 
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ELSE 
CALL DISPLAY_INTEGER(ROW, COLUMN, DIFF,7,B0,SK,SK) 
CALL DISPLAY_INTEGER(ROW, COLUMN+8,R,3,B0,SK,SK) 
CALL DISPLAY (ROW,COLUMN+11,°%’,BO,SK,SK) 
CALL DISPLAY (ROW, COLUMN+14,RATE_LABEL(1),SK.SK,SK) 
END IF 
CONTINUE 


CALL ACCEPT(23,52,HOLD,SK,SK,3K) 
CONTINUE 
CALL CHANGE_SCREEN(CL,SK,SK) 


RETURN 
END 
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SUBROUTINE CHANGE MIXES 


This subroutine is used to control which Outyeor the user wants to 
change, and wether to change Rating or Program mixes for LOS 1. 


I, J, K, ROW These voriables are used os indexes 
into arrays and pointers to positions 
on the screen for displaying. 


YEAR This variable holds the yeor the user 
selected to work on. 


DIS_YEAR Is used to display to the termina! 
which year the user is dealing with. 


ANSWER Will store the answer as to whether 
the user wants to change Program or 
Rating mixes. 


DONE(OUTY) This is an array of flags used to 
flag which years the user has changed. 


NUM_C(OUTY) This motrix has the counts for the 
total number of Rating changes made 
for each outyeor. 


CHANGED(OUTY,RATE) This matrix has the rotings stored that 
the user has changed for each outyeoar. 


ALLOC(20,RATE+1 , PROG+1) Has the allocation matrix for each 
outyeor. 


OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1) Has the Two history yeors and LOS 1 
for each of the outyears with any 
changes made to LOS 1. 

LOS_1_C(OUTY,RATE+1,PROG+1) This matrix stores the LOS 1 allocated 


new recruits with any changes that have 
been made. 


SUBROUTINE CHANGE_MIXES(ALLOC,OUTYEAR,NUM_C,CHANGED,LOS_1_C) 
IMPLICIT NONE 


INCLUDE 'CNA2:[CORLISSG. FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE 'CNA2: [CORLISSG.FORCE]PARAMETERS.FOR’ 


INTEGER I, J, K, ANSWER, YEAR, DIS_YEAR, ROW, NUM_C(OUTY), 
e CHANGED(OUTY,RATE), DONE(OUTY) 


REAL ALLOC(20,RATE+1,PROG+1), OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1), 
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CHARACTER HOLD, ANS 


eS 


Pe ee Ae 


a ow. 


C First check to see if any changes are required. 
CALL CHANGE_SCREEN(CL,SK,SK) 
CALL DISPLAY(13,2,’Would you like to change Program’ ,SK,SK,SK) 
CALL DISFLAY(13,35,’or Rating mixes for any yeor (’,SK,SK,SK) 
CALL DISPLAY(13,65,’°Y’,B0O,SK,SK) 
CALL DISPLAY(13,66,'es or',SK,SK,SK) 


. CALL DISPLAY(13,72,'N’,BO,SK, SK) 
5 CALL DISPLAY(13,73,°0)?',SK,SK,SK) 
5 CONTINUE 


CALL ACCEPT(13,77,ANS,B0,SC,SK) 
IF (ANS .NE. ‘°N’ .AND. ANS .NE. °Y' .AND. ANS .NE. ‘1’ . AND. 
* ANS .NE. ‘y') THEN 
GOTO § 
END IF 


C If no changes then exit this subroutine. 


IF (ANS .EQ. 'N’ .OR. ANS .EQ. ‘n') THEN 
GOTO 9999 


10 CONTINUE 
CALL CHANGE_SCREEN(CL,SK,SK) 


ROW = 2 
T= 1 


OIS_YEAR = CFY 


CALL DISPLAY_INTEGER(ROW, 24,1,2,80,SK,SK) 
CALL DISPLAY(ROW,27,'- Current FY',SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW, 40,DIS_YEAR,4,SK,SK,SK) 
IF (DONE(1) .EQ. 1) THEN 

CALL DISPLAY(ROW,21,°X’,B80,NE,SK) 
END IF 


00 2@ 1=2,O0UTY 
DIS_YEAR = DIS_YEAR + 1 


IF (OUTY .LE. 18) THEN 

: ROW = ROW + 2 
ELSE 

ROW = ROW + 1 
END IF 
CALL DISPLAY_INTEGER(ROW,24,1,2,B0,SK,SK) 
CALL DISPLAY(ROW,27,°- Outyeaor’,SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW,37,1-1,2,SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW, 40,DIS_YEAR,4,SK,SK,SK) 
IF (DONE(I) .£Q. 1) THEN 
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CALL DISPLAY(ROW,21,'X',BO,NE,SK) 


END IF 
t) CONTINUE 
CALL DISPLAY(22,20,’Enter Your Setection or (’,SK,SK,SK) 
CALL DISPLAY(22,45,'99°,B0,SK,SK) 
CALL DISPLAY(22,48,'to end):',SK,SK,SK) 
e CONTINUE 
Accept the year and check to see if good 
selection or finished. 
CALL ACCEPT_INTEGER(22,57,YEAR,2,B80,SC,SK) 
IF (YEAR .EQ. 99) THEN 
GOTO 999 
ELSE IF (YEAR .LT. 1 .OR. YEAR .GT. OUTY) THEN 
CALL DISPLAY(22,6@,'Bad input Hit Return’,BO,NE,B8E) 
CALL ACCEPT(22,8@,HOLD,SK,SK,SK) 
CALL DISPLAY(22, 62,’ ',SK,SK,SK) 
GOTO 328 
END IF 
DIS_YEAR = YEAR + (CFY — 1) 
CALL CHANGE_SCREEN(CL,SK,SK) 
e CONTINUE 
CALL DISPLAY(7,20,’Selection for year',SC,SK,SK) 
CALL DISPLAY_INTEGER(7,39,DIS_YEAR,4,B0,SK,SK) 
CALL DISPLAY(10,20,'1',80,SK,SK) 
CALL DISPLAY(10,21,' -— Change Program Mixes’,SK,SK,SK) 
CALL DISPLAY(12,2@,'2'°,BO,SK,SK) 
CALL DISPLAY(12,21,° -— Change Rating Mixes',SK,SK,SK) 
CALL DISPLAY(14,2@,°9',80,SK,SK) 
CALL DISPLAY(14,21,' -— End Chonging this Outyear’,SK,SK,< 
CALL DISPLAY(17,20,'Enter Your Selection: ’,SK,SK,SK) 
ts) CONTINUE 
Choose whether to change Rating or Program mixes and 
continue unti! 9 is entered. After 9 is entered go 
back to selecting a new year to work with. 


CALL ACCEPT_INTEGER(17,42,ANSWER,1,B80,SC,SK) 


IF (ANSWER .E€Q. 1) THEN 
CALL CHANGE_PROGRAM( YEAR, ALLOC, OUTYEAR, DONE) 
GOTO 40 

ELSE IF (ANSWER .E€Q. 2) THEN 


CALL CHANGE_RATING(YEAR,ALLOC,OUTYEAR,NUM_C,CHANGED , DONE) 


GOTO 40 
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C If you get here then 


ELSE IF (ANSWER .£Q. 9) THEN 
GOTO 10 


C and go back. 
CALL DISPLAY(17,44,'Bad selection <Hit Return>’ ,BO,NE,BE) 


9999 


CALL ACCEPT(17,71,HOLD,SK,SK,SK) 
CALL DISPLAY(17,44,' 


GOTO 5e@ 


CONTINUE 


a ee ee) - - = 2s «c's 


inputed bad selection so display error 


",SK,SK,SK) 


finished af! changes then update LOS_1_C matrix. 


DO 60 [=1,0UTY 
DO 60 J=1,RATE+1 
DO 6@ K:-=1,PROG+1 


LOS_1_C(I,J,K) = OUTYEAR(14+2,1,J,K) 


CONTINUE 


RETURN 
END 
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SUBROUTINE CHANGE PROGRAM 


This subroutine is used to change the program mixes for a certain 
outyear. The total number of accessions for the outyear must 
be the same as entering before the user is allowed to exit. 


I, J, K, START, FINISH, ROW These variables are used as indexes 
into arrays and as pointers to 
positions to dispiay on the screen. 


YEAR, YR These ore used to show which year the 
user has selected to work with and 
what position that is in OUTYEAR. 


CNT Is used to count the number of changes 
made. 
NUM, COIFF These are used as integer numbers 


for displaying and computing. 


ORIG(PROG+1 ) Used to store the rounded integer 
number of how many were originaly 
allocated to each Program. Used for 


disptay purposes only. 


PROGRAMB(PROG+1 ) This matrix is the same as ORIG except 
the changes thot the user makes are 
done to this matrix. Used for computing 
and displaying. 


0(PROG+1) This matrix stores the differences 
of the changes made io Program mixes. 
Used for computing ond displaying. 


DONE (OUTY) If a change is made to this outyear 
a 1 is placed there to flag it. 


ALLOC(2®@,RATE+1,PROG+1) Has the allocation motrix from each 
outyear. 


OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1) Has the two histories and the LOS 1 
for each of the outyears. Will 
have the Program changes after exit. 
REALNUM, DIFFR These are reali number uses for 


computations. 


SUBROUTINE CHANGE_PROGRAM(YR,ALLOC,OUTYEAR, DONE) 


IMPLICIT NONE 
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INCLUDE *CNA2:[CORLISSG.FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE 'CNA2:[{CORLISSG.FORCE]PARAMETERS.FOR' 


INTEGER YEAR, YR, START, FINISH, I, J, K, ORIG(PROG+1), 
CNT, DIFF, ROW, PROGRAMB(PROG+1), D(PROG+1), 
NUM, DONE(OUTY) 


REAL ALLOC(2@,RATE4+1,PROG+1), OUTYEAR(OUTY+2,LOS,RATE+1 ,PROG+1), 
REALNUM, DOIFFR 


CHARACTER HOLD 
YEAR = YR + 2 
CNT = @ 

START = 1 


FINISH = PROG+1 
ROW = 2 


first thing to do is store what the LOS 1 


like by Program for the selected outyear. 


18 loop toads in LOS 1 and computes a total accession. 


ORIG(PROG+1) = @ 
PROGRAMB(PROG+1) = @ 
D(PROG+1) = @ 


DO 1@ I=1,PROG 
ORIG(I) = @ 
PROGRAMB(I) = @ 
O(!) = @ 
ORIG(I) = OUTYEAR(YEAR,1,RATE+1,1) + .5 
PROGRAMB(I) = OUTYEAR(YEAR,1,RATE+1,1) + .5 
ORIG(PROG+1) * ORIG(PROG+1) + ORIG(1) 
PROGRAMB(PROG+1) = PROGRAMB(PROG+1) + PROGRAMB(1I) 


CALL CHANGE_SCREEN(CL,SK, SK) 


CALL DISPLAY (2,39, ’Orig’.SC,SK.Sk) 
CALL DISPLAY (2,58, 'Change’,SC,SK,SK) 
CALL DISPLAY (2,62, 'Diff’,SC,SK,SK) 


CALL DISPLAY (4,1@,'°1',BO,SK,SK) 

CALL DISPLAY (4,11,° - 4YO Program ’,SK,SK,SK) 
CALL DISPLAY (6,10,'2',BO,SK,SK) 

CALL DISPLAY (6,11,' - Active Mariner Program’ ,SK,SK,SK) 
CALL DISPLAY (8,10@,°3',BO,SK,SK) 

CALL DISPLAY (8,11,° -— 5&6YO Program ",SK,SK,SK) 
CALL OISPLAY(10,10,°4',BO,SK,SK) 

CALL DISPLAY(10,11,’ - Prior Service Program ',SK,SK,SK) 
CALL DISPLAY(12,10,'°5',80,SK,SK) 

CALL DISPLAY(12,11,°’ — TAR Program *,SK,SK,SK) 
CALL DISPLAY(14,10,'°6',BO,SK,SK) 

CALL DISPLAY(14,11,' - Sea College Program ’,SK,SK,SK) 


CALL DISPLAY(16,10,'7',BO,SK,SK) 


D-33 


“a IVPn rs AY ei Ces ye Fo Ow wes 


Poet ie ek 


TR tee et PRA WA Tw, 


a a as 


Paar Ae 


2 


3 


BWA FW ee ee ee a ee a ea ee ee ew 


CALL DISPLAY(16,11,° - Any new program ",SK,SK,SK) 
CALL DISPLAY(18,28, 'Totals’,SK,SK,SK) 


DO 20 I=START, FINISH 
ROW = ROW + 2 
CALL DISPLAY_INTEGER(ROW,37,0RIG(1),6,.B0,SK,SK) 
CALL DISPLAY_INTEGER(ROW,50,PROGRAMB(1),6,B0,SC,SK) 
CALL DISPLAY_INTEGER(ROW,60,D(1),6,80,SK,SK) 


@ CONTINUE 
CALL DISPLAY(21,10,'’Enter Program to change or <Return>:',SK,SK,SK) 
Q CONTINUE 
CALL ACCEPT_INTEGER,(21,.47,START,1,B0,SC,SK) 
After a program is selected to change the user inputs 
the new number ond the difference is computed and displayed. 
If a change is made an equal change must be made in some other 
Program to offset it. 
IF (START .GT. @ .AND. START .LT. PROG+1) THEN 
IF (START .EQ. 6) THEN 
CALL DISPLAY(23,15, 'Cannot change Sea College here’, 
* BO,NE,8E) 
CALL DISPLAY(23,46,'<Hit Return>',SK,SK,SK) 
CALL ACCEPT(23,58,HOLD,SK,SK,SK) 
CALL OISPLAY(23,15,° a 
e SK,SK,SK) 
CALL DISPLAY(23,46,' ’,SK,SK,SK) 
GOTO 30 
END IF 
CNT = CNT + 1 
ROW = 2 + (START « 2) 
NUM = PROGRAMB(START) 
CALL ACCEPT_INTEGER(ROW, 5@,PROGRAMB(START) ,6,B0,SC, SK) 
O(START) = D(START) + (PROGRAMB(START) -— NUM) 
O(PROG+1) = O(PROG+1) + (PROGRAMB(START) - NUM) 
PROGRAMB(PROG+1) = PROGRAMB(PROG+1)+(PROGRAMB(START )-NUM) 
CA‘ *. DISPLAY_INTEGER( ROW, 6@,0(START),6.B0.SK,NE) 
CALL DISPLAY_INTEGER(18,60,D(PROG+1),6,B0,SK,NE) 
CALL DISPLAY_INTEGER(18,50,PROGRAMB(PROG+1),6,80,SK,NE) 
GOTO 30 
ENO IF 
If no changes were made then exit subroutine. 
IF (CNT .EQ. @) THEN 
GOTO 999 
END IF 
DONE(YEAR-2) = 1 
DIFF = PROGRAMB(PROG+1) - ORIG(PROG+1) 
This IF statement is checking to make sure that before 
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C exiting the total is the same as when entering the subroutine. 
C &If not an error message is sent to the user and more changes 
C must be made. 
IF (DIFF .GT. @ .OR. DIFF .LT. @) THEN 
CALL DISPLAY(23,10,’The Total has to =’,80,NE,BE) 
CALL DISPLAY_INTEGER(23,29,0RIG(PROG+1),6,80,SC,SK) 
CALL DISPLAY(23,36,'not’,80,NE,SK) 
, CALL DISPLAY_INTEGER(23, 4@,PROGRAMB(PROG+1),6,80,SC, SK) 
. CALL DISPLAY(23,49, '<Hit Return>’,BO,NE,SK) 
CALL ACCEPT(23,62,HOLD,SK,SK,SK) 
CALL DISPLAY(23,10,° 
» * ,SK,SK,SK) 
‘ CALL DISPLAY(23,45,° 
* ,SK,SK,SK) 
GOTO 38 
END IF 
Cm a a a a a a a a a a a ee 
C After all changes are made and the totals equa! the excess or 
C deficit in each new Program total must be distrubted back over aii 
C the Ratings using the ALLOC matrix. The 40 loops do this. 
DO 4@ K=1,PROG 
DIFFR = PROGRAMB(K) - OUTYEAR(YEAR,1,RATE+1,K) 
DO 40 J=i,RATE 
IF (ALLOC(YEAR,RATE+1,K) .NE. @) THEN 
OUTYEAR(YEAR,1,J7,K) = OUTYEAR(YEAR,1,J,K) + 
. ((ALLOC(YEAR,J,K)/ALLOC(YEAR,RATE+1,K)) © DIFFR) 
END IF 
40 CONTINUE 
Cs25 5-5 — SSeS ac ee ee ee oe eee ee ee ona ee ae eo eee 
Coee Sante a So see ee oo Se a aa ee ee a See eee esa e aoa ae Se ae ee eee 
C The 50 and 60 joops zero out the Program and Rating tota!i so they 
C can be recomputed. 
DO 50 K=1,PROG+1 
50 OUTYEAR(YEAR,1,RATE+1,K) = 0.@ 
DO 60 J=1,RATE 
60 OUTYEAR(YEAR,1,J0,PROG+1) = 0.0 
CaeSa 6 SSS ee Se ase Se Soe ee eee Se ee eee ee eee eee 
Css 5 2 SSS ee eee oes SoS ae Set eee Soe ae Ste oe ee ee eee eee 


C The 70 toops recompute the LOS 1 totats for Rating and Program. 


DO 70 J=#1,RATE 
DO 70 K=1,PROG 
OUTYEAR(YEAR,1,J0,PROG+1) = OUTYEAR(YEAR,1,J/,PROG+1) + 


e OUTYEAR(YEAR,1,J,K) 
: OUTYEAR(YEAR,1,RATE+1,K) = OUTYEAR(YEAR,1,RATE+1,K) + 
. OUTYEAR(YEAR,1,J,K) 
OUTYEAR(YEAR,1,RATE+1,PROG+1) = OUTYEAR(YEAR,1,J3,K) + 
; ° OUTYEAR( YEAR, 1,RATE+1t , PROG+1 ) 
70 CONTINUE 
c a ee le a ee ae a a ee ee ew a a es i a a a a a i ee we ee 
999 CONTINUE 
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CALL CHANGE_SCREEN(CL,SK,SK) 


RETURN 
ENO 


———- © 2 2 se 2 ee = oe oe 4s =e 
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SUBROUTINE 


CHANGE RATING 


This subroutine is used to change Rating mixes for the outyeor the 
user selected. The total number for the ratings must be the some 


after the changes are done. 


I, J, K, Lb, ROW, COLUMN 


YEAR, YR 


RATING_INDEX(RATE) 


NUM_RATING 
SUMB, SUMA 
CNT 

DIFF, MA 


RATINGB(RATE,PROG+1 ) 


DONE(OUTY) 


NUM_C(OUTY) 


CHANGED (OUTY,RATE) 


DIFFR 


ALLOC(2@, RATE+1,PROG+1) 


These voriables are used os indexes 
into arrays and as pointers to 
positions on the terminal. 


These are used to show which year the 
user has selected to work with and 
what position that is in OUTYEAR. 


This matrix stores the ratings that the 
user has chosen to work with. 


This is a count of the number of ratings 
that have been selecied. <= Q9. 


These are used to show the sum of the 
ratings before changes are made and 
after. These two should equal ut the 
end of this subroutine. 


This counts the number of rating groups 
the user changed. 


Used as integer numbers for computing 
and storage. 


This matrix has the allocated numters 
stored for the rating selected and 

is used for making changes by the user. 
It is integer for displaying purposes. 


This is an array of flags. If any 


rating changes ore made in this yeor it 
is flaged t in that pos. of DONE. 


This matrix has the counts for the 
total number of Rating changes made for 
each outyeoar. 


This matrix has the rotings stored that 
the user has changed for this outyear. 


This is just used in the program as oa 
real number for computations. 


Has the allocation matrix for each 
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c outyear. 
Cc 
Cc OUTYEAR(OUTY+2,L0OS,RATE+1,PROG+1) Has the two histories and the LOS 1 
C for each of the outyears. Will 
C have the Rating changes for this 
c outyear after exit. 
Cc 
Cc MAX(20,RATE+1,9) This matrix is read into the program 
c and stores the maximum number allowed - 
Cc for each rating for each of the 
C outyears. This matrix is used to flag 
Cc for the user the ratings which exceed . 
Cc the school plan. 4 
Cc ee ee ree ee we we we we ee we a a a a a ew we ew we ew ne ew ee oe 
SUBROUTINE CHANGE_RATING(YR,ALLOC,OUTYEAR,NUM_C, CHANGED, DONE) 
IMPLICIT NONE 
INCLUDE ‘CNA2:{CORLISSG. FORCE ]SCREEN_PARAMETERS. FOR' 
INCLUDE ‘*CNA2:(CORLISSG.FORCE]PARAMETERS. FOR’ 
INTEGER RATING_INDEX(RATE), NUM_RATING, I, J, K, SUMB, SUMA, 
* YEAR, YR, ROW, COLUMN, DIFF, RATINGB(RATE,PROG+1), CNT, 
. NUM_C(OUTY), CHANGED(OUTY,RATE), L, MA, DONE(OUTY) 
REAL DIFFR, ALLOC(20,RATE+1,PROG+1), MAX(2@,RATE+1,9), 
. OUTYEAR(OUTY+2,LOS,RATE+1 ,PROG+1) 
CHARACTER HOLD 
CHARACTER®8 RATE_LABEL 
YEAR = YR + 2 
CALL CHANGE_SCREEN(CL,SK,SK) 
Cea c ena waa =e Se SSS ee eo oe a ee a eS see eee eae 
C Calling this subroutine allows the user to select 


C the ratings to work with. 
CALL CHOOSE_RATING(RATING_INDEX, NUM_RATING) 
eee ae a es ae oo ae oa a a aa aa ae a ee ee a ee eae eee 
Gseeescncas Soe a soa nea Se eee oa So Sa Secs 
C Onty 9 ratings can be worked with at one time. 
IF (NUM_RATING .GT. 9) THEN 
NUM_RATING = 9 
END IF 
Geeta Se ee ee Soe eee See eo ee 
OPEN(UNIT=59,READONLY,STATUS='OLD‘’ , FORM=’ UNFORMATTED’, 
. FILEm’CNA2:[CORLISSG.FORCE.DAT]MAX.DAT’ ) 
READ(59) MAX 
CLOSE(UNIT=59) 
CALL DISPLAY(2,13,'4Y0' ,SC,SK,SK) 
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CALL DISPLAY(2,18,'ACT MA’,SC,SK,SK) 
CALL DISPLAY(2,27,'°5&6Y0' ,SC,SK,SK) 
CALL DISPLAY(2.34,’PR SER’,SC,SK,SK) 
CALL DISPLAY(2,44,'TARS’ ,SC,SK,SK) 
CALL DISPLAY(2,50,’SEA CO’,SC,SK,SK) 
CALL DISPLAY(2,59,’ OTHER’ ,SC,SK,SK) 
CALL DISPLAY(2,67,’TOTAL’ ,SC,SK,SK) 
CALL DISPLAY(2,77,'MAX’ ,SC,SK,SK) 


C The 18 and 20 toops load in the original allocation, 
C for the selected ratings, into RATINGB and also sums up 
C the total of the ratings. The numbers for RATINGB ore 
C integer for displaying, and therefore are rounded up to the 
C nearest integer. 
DO 10 IT=1,NUM_RATING 

RATINGB(I,PROG+1)=OUTYEAR(YEAR,1,RATING_INDEX(I) ,PROG+1)+0.5 

10 SUMB = SUMB + RATINGB(I,PROG+1) 


DO 20 I=1,NUM_RATING 
DO 20 J=1,PROG 


22 RATINGB(I,J) = OUTYEAR(YEAR,1,RATING_LINDEX(I),J) + 0.5 
Cc a a a ee ee a a ee ee ee eee 

ROW = 2 
a 
C The 30 and 4@ loops display the numbers for the Rating 
C by program on the terminal. Also, the MAX is displayed. 

DO 40 J=1,NUM_RATING 

COLUMN = 1 


ROW = ROW + 2 
CALL DISPLAY(ROW,COLUMN,RATE_LABEL(RATING_INDEX(1)),SK,SK,SK) 
COLUMN = 2 
DO 30 K=1,PROG+1 
COLUMN = COLUMN + 8 
CALL DISPLAY_INTEGER( ROW, COLUMN, RATINGB(I,K),6,SK,SK,SK) 
38 CONTINUE 


COLUMN = COLUMN + 8 
MA = MAX(YEAR,RATING_INDEX(1I),8) 


IF (MA .LT. RATINGB(1,PROG+1)) THEN 
CALL DISPLAY_INTEGER( ROW, COLUMN,MA,6,B0,NE,SK) 


S ELSE 
CALL DISPLAY_INTEGER( ROW, COLUMN,MA,6,SK,SK,SK) 


ENO IF 
40 CONTINUE 


CALL DISPLAY(22,5,’Enter ROW and COLUMN to change or <Return>’, 
* SK,SK,SK) 
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CALL DISPLAY(22,52, ROW _ COLUMN _‘,SK,SK,SK) 
58 CONTINUE 
CALL DISPLAY(22,67,' °,B0,SC,SK) 


CALL ACCEPT_INTEGER(22,56,ROW,1,B0,SC,SK) 

IF (ROW .LT. 1 .OR. ROW .GT. NUM_RATING) THEN 
GOTO 888 

END IF 


CALL ACCEPT_INTEGER(22,67,COLUMN,1,B0,SC,SK) 

IF (COLUMN .LT. 1 .OR. COLUMN .GT. PROG+1) THEN 
GOTO 888 

END IF 

CNT = CNT + 1 

J = ROW 

K = COLUMN 


C The 6@ !toop checks to see if the rating you have selected has been 


C changed already. If no change yet then it adds it to the list of changed. 


DO 6@ L=1,NUM_C(YEAR-2) 
IF (RATING_INDEX(J) .EQ. CHANGED(YEAR-2,L)) THEN 
GOTO 72 
END IF 
60 CONTINUE 


NUM_C(YEAR-2) = NUM_C(YEAR-2) + 1 
CHANGED ( YEAR-2,NUM_C(YEAR=2)) = RATING_INDEX(J) 
70 CONTINUE 


ROW = (ROW « 2) + 2 
COLUMN = (COLUMN « 8) + 2 


CALL ACCEPT_INTEGER(ROW, COLUMN, RATINGB(J,K),6,B0,SC,SK) 


(ee 
C The if structure is checking to see if an individual program 
C cell for a rating has been changed or if the total over al! the 


C Programs was changed. (PROG+!1 is the total) 
IF (K .EQ. PROG+1) THEN 


DIFFR = RATINGB(J,PROG+1) - OUTYEAR(YEAR,1,RATING_INDEX(J),PROG+1) 
OUTYEAR(YEAR,1,RATING_INDEX(J),PROG+1) = RATINGB(J,PROG+1) 
COLUMN = 2 


C The 8@ !oop is reallocating the new total back over the programs for the 
C rating then displaying the new numbers for the user. 
DO 80 I=1,PROG 
OUTYEAR(YCAR,1,RATING_INDEX(J),1) = 
. OUTYEAR(YEAR,1,RATING_INDEX(J),1) + 
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* ((ALLOC(YEAR, RATING_INDEX(J),1)/ 

* ALLOC(YEAR,RATING_INDEX(J),PROG+1)) © DIFFR) 
RATINGB(J,1) = OUTYEAR(YEAR,1,RATING_INDEX(J),1) + .5 
COLUMN = COLUMN + 8 
CALL DISPLAY_INTEGER(ROW, COLUMN, RATINGB(J,1),6,80.SC,SK) 


Be CONTINUE 
; ELSE 
C é«OTf only a cell is changed then the total just has to be adjusted and 
C displayed for the user. 
. DIFFR = RATINGB(J,K) - OUTYEAR(YEAR,1,RATING_INDEX(J),K) 
r OUTYEAR(YEAR,1,RATING_INDEX(J),PROG+1) = 
* OUTYEAR(YEAR,1,RATING_INDEX(J),PROG+1) + DIFFR 


RATINGB(J, PROG+1)#OUTYEAR( YEAR, 1,RATING_ INDEX (J) ,PROG+1)+@.5 
OUTYEAR(YEAR,1,RATING_INDEX(J),K) = RATINGB(J,K) 


COLUMN = 66 
CALL DISPLAY_INTEGER(ROW, COLUMN ,RATINGB(J,PROG+1),6,80,SC,SK) 


END IF 


C After a change check the MAX to flag the user if exceeded it. 
MA = MAX(YEAR,RATING_INDEX(J),8) 


IF (RATINGB(J,PROG+1) .GT. MA) THEN 
CALL DISPLAY_INTEGER(ROW,74,MA,6,B0,NE,SK) 


ELSE 
CALL DISPLAY_INTEGER(ROW,74,MA,6,SK,SK,SK) 


C The GOTO 5@ sends the program back so the user can make another change. 


GOTO 50 


C- After the user has decided to exit changing rating the program 
C sends the flow to 888. 
888 CONTINUE 


C If no changes were made then exit subroutine ot 999. 
IF (CNT .EQ. @) THEN 
GOTO 999 
END IF 


y C When there is a change for this outyear then flag it using DONE. 
DONE(YEAR-2) = 1 


SUMA = @ 


C The 9@ loop is calculating the sum of the ratings selected 
C after the changes are made. Then the SUMB shouid = SUMA. 
DO 98 I#1,NUM_RATING 
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98 
DIFF = $ 


C The IF is che 
C asked if it i 
IF (OIFF 


CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 


C If the answer 


IF (H 
END I 
END IF 
Gswas 2522S Sae 
Cxsnee ose SKS SS 
C After the use 
C close enough 
C used to recom 
DO 100 J 
100 
DO 118 K 
11 OUTY 
DO 120 J 
OUTY 
s 
OUTY 
e 
OUTY 
e 
120 CONTINUE 
Gsse-s5 oSSeo2e25 
999 CONTINUE 


SUMA = SUMA + RATINGB(I,PROG+1) 
UMA - SUMB 


cking to make sure the two sums are =. If not the user its 
s close enough. 


.NE. @) THEN 
DISPLAY(23,5,° *,SK,SK,SK) 
DISPLAY(23,35,’ * SK,SK,SK) 
DISPLAY(23,65,' " SK,SK,SK) 

DISPLAY(23,5, ‘The Total is’,SK,SK,BE) 


DISPLAY_INTEGER(23,18,SUMA,6,B0,SC,SK) 
DISPLAY(23,25, which is off by’,SK,SK,SK) 
DISPLAY_INTEGER(23,41,DIFF,6,B0,SC,SK) 
DISPLAY(23,48,’Is this close enough (’,SK,SK,SK) 
DISPLAY(23,70,’Y',BO,SK,SK) 

DISPLAY(23,71,° or’,SK,SK,SK) 
DISPLAY(23,75,'N’,BO,5K,SK) 
DISPLAY(23,76,°)?°,SK,SK,SK) 
ACCEPT(23,79,HOLD,BO,SC,SK) 


DISPLAY(23,5,° *.SK,SK,SK) 
DISPLAY(23,35,° ' SK,SK,SK) 
DISPLAY(23,65,° ’,SK,SK,SK) 


is not close enough GOTO 5@ and make more changes. 
OLD .NE. ‘'Y' .AND. HOLD .NE. ‘y') THEN 
GOTC 5@ 
F 


a en a ee 


r is satisyed thot the beginning and ending sums are 
or if there equal, then the 100,110,120 ftoops are 
pute the totals for the LOS 1 of this outyear. 
=1,RATE 

OUTYEAR(YEAR,1,J,PROG+1) = 0.0 


=1,PROG+1 
EAR(YEAR,1,RATE+1,K) = @.@ 


=1,RATE 

DO 12@ K=1,PROG 

EAR(YEAR,1,RATE+1,K) = OUTYEAR(YEAR,1,RATE+1,K) + 
OUTYEAR(YEAR,1,J,K) 

EAR(YEAR,1,J,PROG+1) = OUTYEAR(YEAR,1,J,PROG+1) + 
OUTYEAR(YEAR,1,0,K) 

EAR(YEAR,1,RATE+1,PROG+1) = OUTYEAR(YEAR,1,4,K) + 

OUTYEAR(YEAR,1,RATE+1,PROG+1) 
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CALL CHANGE_SCREEN(CL, SK, SK) 


RETURN 
END 
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Cc aa Se a a ee a a Sa a a a ee a a a a a a a a a a a ae a a ee a a ae a a a ee Sa ea a 
Cc 
c SUBROUTINE CHECK TO SEE IF NEW ALLOC 
c 
Qveeecoso Seto st ee 8 oe So oo Sa eae a a ee ae ae Sao ee = Se eee ee 
Cc 
c This subroutine asks the user if the allocation matrix being used in 
Cc this run should be saved on disk or not. 
c 
c LOS_1_C(OUTY,RATE+1,PROG+1) This matrix is passed into this sub. 
Cc ond it contains the matrix to be used 
c in this run. 
Cc 
Cc NEW_LOS1(OUTY,RATE+1, PROG+1) This motrix is filled with LOS_1_C and 
Cc then is used to work with in creating 
Cc the new allocation. 
Cc 
Cc NEW_ALLOC(2@,RATE+1,PROG+1) This matrix will store the aliocation 
Cc percents and is written to disk for 
Cc use ina later run. 
@ oie ee see eee Se oe ee eee eee ee ee Sn Boe ee eee eS 
SUBROUTINE CHECK_TO_SEE_IF_SAVE_NEW_ALLOC(LOS_1_C) 
INCLUDE ’CNA2:[CORLISSG.FORCE]SCREEN_PARAMETERS.FOR' 
INCLUDE 'CNA2:[CORLISSG. FORCE ]PARAMETERS.FOR’ 
REAL LOS_1_C(OUTY,RATE+1,PROG+1), NEW_ALLOC(20,RATE+1,PROG+1), 
° NEW_LOSIT(OUTY,RATE+1 , PROG+1) 
CHARACTER ANS 
CHARACTER*5@ FILEN 
CHARACTER¢25 NAME 
CALL CHANGE_SCREEN(CL,SK,SK) 
Oncaea s ses Sao e Sn eS a eae an Sa a eo ae ba So a eS a See 
C The first thing is to ask the user this allocation siould be 
C saved. If not then exit subroutine. 
CALL DISPLAY(10,10, ‘Would you like to save this allocation (', 
. SK,SK.SK) 
CALL OISPLAY(10,50,'Y’ ,BO,SK,SK) 
CALL DISPLAY(10,51,'es of',SK,SK,SK) 
CALL DISPLAY(10,57,°N’,BO,SK,SK) 
CALL DISPLAY(10,58,'0)?'°,SK,SK,SK) 
5 CONTINUE 
CALL ACCEPT(10,62,ANS,80,SC,SK) 
IF (ANS .NE. 'N’ .AND. ANS .NE. ‘Y’ .AND. ANS .NE. ‘rn’ . AND. 
. ANS .NE. ‘y') THEN 
GOTO 5 
END IF : 
IF (ANS .EQ. "N’ .OR. ANS .£Q. ‘n‘) THEN 
GOTO 999 
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END IF 


a, ee Dt fa a 


CALL DISPLAY(14,5,'Enter a name to save this allocation under’, My 
. SK,SK,SK) i) 
10 CONTINUE : 
NAME = ° , = 
CALL ACCEPT(14,48,NAME,BO,NE,SK) 2 
i 
: IF (NAME .EQ. ' ’) THEN * 
GOTO 18 nN 
END IF 
a os 
z FILEN = 'ZZZ_'//NAME » 
OPEN(UNIT=6@,STATUS='NEW' ,FILE=FILEN, FORM=’UNFORMATTED’ , ERR=1@) 
Ca ere 
C The 20 loop sets the NEW_LOS1 matrix equal to the passed in LOS_I_C matrix, > 
C $0 we can work with NEW_LOS1. 2 
DO 20 K=1,PROG+1 
00 20 J=w1,RATE+1 ' 
DO 2@ I=1,0UTY 
20 NEW_LOS1(1I,u,K) = LOS_1_C(I,u,K) ¢ 
€ wa re nr nnn > 
e 
C-------------------------------------------------------------- i 
C The 38 and 4@ loops subtract out the Sea College new recruits ‘ 
C because they do not work like the rest of the programs. i 
DO 4@ I=1,0UTY ' 
NEW_LOS1(1,RATE+1,PROG+1) = ) 
* NEW_LOS1(1,RATE+1,PROG+1) - NEW_LOS1(1,RATE+1,6) ; 


NEW_LOS1(I,RATE+1,6) = 0.2 


DO 3@ J=1,RATE 
NEW_LOS1(I,J,PROG+1) = NEW_LOS1(I,J,PROG+1) — 
. NEW_LOS1(1I,u,6) 
NEW_LOS1(1I,J,6) = 0.8 
30 CONTINUE 
40 CONTINUE 


i ae a ee ee ee. 


C The 5@ loop actually creates the new allocation percents to be 
C written to disk for uses later. 
DO 5@ K=1,PROG+1 
00 50 J=t,RATE+1 
2 DO 58 I=#1,0UTY | 
IF (NEW_LOS1(1,RATE+1,PROG+1) .GT. @) THEN 
NEW_ALLOC(I,J,K) = NEW_LOS1(1,J,K) / 
. NEW_LOS1(1,RATE+1, PROG+1) 
ELSE 
; NEW_ALLOC(I,J,K) = 0.0 
END IF | 
bo) CONTINUE 
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C The 60 loop makes every year pased OUTY = to the allocation at 
C The OUTY dimension. 
DO 60 K=1,PROG+1 
DO 62 J=1,RATE+1 
DO 60 I*OUTY+1,290 
62 NEW_LALLOC(I,J.K) = NEW_ALLOC(OUTY,J,K) 


WRITE(6@) NEW_ALLOC 
CLOSE(UNIT=60) 
999 CONTINUE 


RETURN 
END 
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SUBROUTINE 


This is the main subroutine of this program. This subroutine 
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transitions the history and new recruits that the user has inputed. 


SUB_LOSS (PROG) 


ACCESS(OUTY) 


TRANS(LOS-2,RATE,PROG) 


N_D(LOS—2,RATE, PROG) 


These variables are used as indexes 
into arrays. 


This arroy is used to show how the 
Programs need to be cojilapsed for the 
LOSS matrix. 


This array is passed to this subroutine 
and it contains the number of recruits 
that the user input for each outyear. 


This array is used to store the 
continuation rates from one SEPT. to 
the next. Is capted at 1.0. It is 
passed into the subroutine. 


This array is to show what percent is 
to be aded back. This array is 0.@ 
except where TRANS is = 1.8. This 
array is also passed into the 
subroutine. 


OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1) This array is passed into this 


PRIOR_LOS(LOS, RATE) 


ADDER(LOS,RATE, PROG) 


LOSSES (OUTY,RATE,PROG-3) 


REALNUM 


subroutine and it has two years of 
History and LOS 1 filted out for 
each outyear. After this subroutine 
this array will be filed with the 
transitioned history. 


This array will be read into this 
subroutine and it contains the percents 
to show how the newblood Prior Service 
break out into LOS and RATING. 


This array is recreated for each 
outyear of the simulation. It will 
contain numbers that show what to add 
back to each Rating and Program 
combinat.on in each LOS. 


This is used to compute the losses for 
each outyear. This array will be 
written out to be used by the reserve 
simulation. 


Is used for computing purposes 
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c SEA_C(RATE, RATE) This matrix shows how and where the 
Cc user inputed SEA COLLEGE recruits will 
c end up in LOS 3. 


SUBROUTINE TRANSISTION( ACCESS, OUTYEAR, LOSSES) 
IMPLICIT NONE 


INCLUDE 'CNA2:[CORLISSG.FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE 'CNA2:[CORLISSG.FORCEJPARAMETERS. FOR’ 


INTEGER I, J, K, L, M, N, SUB_LOSS(PROG), ACCESS(OUTY) 


REAL TRANS(LOS-2,RATE,PROG,3), LAT(LOS-2,PROG), 

* OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1), PRIOR_LOS(LOS,RATE), 
. ADDER(LOS-2,PROG), LOSSES(OUTY,RATE,PROG-3), REALNUM, 
SEA_C(RATE,RATE) 


DATA SUB_LOSS/1,2,1,1,1,3,4/ 


CALL CHANGE_SCREEN(CL,SK,SK) 

CALL DISPLAY(6,15,'Piease woit while simulation takes place’, 

® BO,NE,SK) 

CALL DISPLAY(10,15,’Beginning to transition the history’,BO,SK,SK) 


ewe we we ews ee 
e 


C--- Initializing 


DO 10 K=1,PROG-3 
DO 10 Jm1,RATE 
DO 10 I=#1,OUTY 
10 LOSSES(I,J,K) = 0.0 


a ee ee ee a ae oe 


OPEN(UNIT#59,STATUS='OLD’ , FORM=™’ UNFORMATTED’ ,READONLY, 
FILE='’CNA2: [CORLISSG.FORCE.EMR}MATCH8586_PCTS. DAT’ ) 

READ(59) TRANS 

CLOSE(59) 


ax € 2 2 84 ee 
e 


OPEN(UNIT#=59,STATUS=’OLD’ ,READONLY,FORM=@'’UNFORMATTED’, 

® FILE='CNA2:[CORLISSG.FORCE.EMR]JMATCH8586_LAT_PCTS.DAT’ ) 
READ(59) LAT 

CLOSE(59) 


OPEN (UNIT#59,READONLY,STATUS='OLD’,FORM='’UNFORMATTED’, 
* FILEm’CNA2: ([CORLISSG.FORCE.DATJPRIOR_LOS.DAT’ ) 
READ(59) PRIOR_LOS 
CLOSE(UNIT=59) 


he Se ee OY Ls 


Me OPEN (UNI T=59,READONLY,STATUS=’OLD’ ,FORM=’'UNFORMATTED’ , 
5 * FILE=’*CNA2: [CORLISSG.FORCE.DAT]SEA_C.DAT' ) 
iB READ(59) SEA_C 
CLOSE(UNIT=59) 


CALL CREATE_AODER(2,OUTYEAR, LAT, ADDER) 


Pf ft fa K A 
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C The 9@ and 40 toops are the main loops of 
C this simulation. This is where the history 
C is transitioned into to future. 
DO 98 I=3,0UTY+2 
DO 48 L=1,PROG 
DO 40 K=1,RATE 
C First thing is to create LOS 2 ot 91.6% survival from last years LOS 1. 
C 0.903 was created by taking the 85 LOS 1 -> LOS 2 
C continuation rates for all programs. @.908 IS ATTRITION FROM LOS @ -> LOS 1. 
OUTYEAR(I,2,K,L) = OUTYEAR(I-1,1,K,L) © @.903 «© 0.908 
Geen SUS eae 
C Calculating LOS 3 for each of the outyears. It is nessary to break out 
C LOS 3 because the first transition from 1 --> 3 is taken from Two years 
C ago and the rest of the LOS'’s are computed from 1 year ago. 
Cc 
OUTYEAR(I,3,K,L) = OUTYEAR(I-2,1,K,L) * TRANS(1,K,L,1) 
LOSSES(I-2,K,SUB_LOSS(L)) = LOSSES(I-2,K,SUB_LOSS(L)) + 
* (OUTYEAR(I~2,1,K,L) © TRANS(1,K,L,2)) 
OUTYEAR(I,3,K,L) = OUTYEAR(!,3,K,L) + 
* (ADDER(1,L) ¢ TRANS(1,K,L,3)) 
OUTYEAR(I,1,K,L) = OUTYEAR(!I,1,K,L) © @.908 
ee ee 
ere 


C The 20 joop calculates LOS 4-9. LOS’s 4 to 9 ore unique because al! the 
C programs are kept in the transition rates. 
Cc 


DO 20 J=4,9 
OUTYEAR(I,J,K,L) = OUTYEAR(I-1,J-1,K,L) * TRANS(J-2,K,L,1) 


LOSSES(I-2,K,SUB_LOSS(L)) = LOSSES(I-2,K,SUBLLOSS(L)) + 
. (OUTYEAR(I-1,J-1,K,L) * TRANS(J-2,K,L,2)) 


OUTYEAR(I,J,K,L) = OUTYEAR(I,J,K,L) + 


* (ADDER(J-2,L) * TRANS(J-2,K,L,3)) 
20 CONTINUE 
(Co a ee 
(CE ae 
C The 30 loop calculates OUTYEAR for LOS1®-LOS-31. This loop is nessary 
C because after LOS 9 all programs transition to program 1, and then 


C onty Program 1 is used. 
DO 30 J=10,L0S 


OUTYEAR(I,J,K.1) = OUTYEAR(I,J.K,1) + 
* (OUTYEAR(I-1,J-1,K,L) * TRANS(J-2,K,L,1)) 
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LOSSES(I-2,K,SUB_LOSS(L)) = LOSSES(I-2,K,SUB_LOSS(L)) + 
° (OUTYEAR(I-1,J-1,K,L) * TRANS(J-2,K,L,2)) 


OUTYEAR(I,J,K,1) = OUTYEAR(I,J,K,1) + 
* (ADDER(J-2,L) * TRANS(J-2,K,L,3)) 


3@ CONTINUE 


40 CONTINUE 


C The 5@ loop is nessary to take the SEA COLLEGE recruits and move them to the 
C appropriate ratings in two yeors. This loop does the 1 --> 3 transition for 
C Sea College using the SEA_C matrix which is read into the program. 
DO 50 J=1i,RATE 
DO 5@ K=1,RATE 


50 OUTYEAR(I,3,K,6) = OUTYFAR(I,3,K,6) + 
* (QUTYEAR(I1-2,1,0,6) * SEA_C(JU,K)) 
Ce ee 
(See ee ee 
C The next set of loops are used to take the Newblood Prior Service people 
C and redistrubite them to the proper LOS, ani Rating. The Newbloods are 
C sitting at LOS 1 before this loop and the FRIOR_LOS matrix is read into the 
C program to show where the individuals go. 


OUTYEAR(1,1,RATE+1,PROG+1) = OUTYEAR(I,1,RATE+1,PROG+1) - 
. OUTYEAR(1,1,RATE+1,4) 


DO 80 K=1,RATE 
REALNUM = OUTYEAR(I,1,K,4) 
OUTYEAR(I,1,K,4) = 0.0 


DO 60 J=1,9 
60 OUTYEAR(I,J,K,4) = OUTYEAR(I,J,K,4) + : 
. (REALNUM * PRIOR_LOS(J,K)) 


C After LOS 9 only Program 1 exists. 
DO 70 J=#1®,LOS 


70 OUTYEAR(I,J,K,1) = OUTYEAR(I,U,K,1) + 
* (REALNUM « PRIOR_LOS(J,K)) 

80 CONTINUE 

(o} we ee oe eo oe oe oo oe 


C Call CREATE_ADDER to get the new additions for the next outyear 
IF (1 .NE. OUTY+2) THEN 
CALL CREATE_ADDER(I,OUTYEAR,LAT,ADDER) 
END IF 
90 CONTINUE 


CALL DISPLAY(11,15,'’Finished creating the outyeor inventories’, 
. BO,SK,SK) 


RETURN 
END 
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C--- 


18 


SUBROUTINE CREATE ADDER 


This subroutine is called by TRANSITION and it creates an array io show 
how many individuals to add back for the next outyear. 


I. J, K These variables are used as indexes 
into arrays. 


YEAR Is used to determine which year is 
being worked with. It is passed into 
this subroutine. 


ACCESS(OUTY) It is passed to this subroutine and it 
shows what the user input for new 
recruits for each outyeoaor. 


OUTYEAR(OUTY+2,L0S,RATE+1,PROG+1) Is used to calculate the rating 
and LOS 1 bases needed for N_D. 


N_O0(LOS-2,RATE,PROG) This array is to show what percent is 
to be aded back. This array is @.@ 
except where TRANS is = 1.0. This 
array is passed into this subroutine. 


BIG_T , Will store the total accessed at YEAR-2. 


ADDER( LOS, RATE, PROG) It will contain numbers that show what 
to add back to each Rating and Program 
combination in each LOS. Is computed 
using N_DO. 

TOT(RATE) This is used to store the total! number 


in each rating for YEAR-1. This is 
needed by N_D for LOS'’s 4-los. 


SUBROUTINE CREATE_ADDER( YEAR, OUTYEAR, LAT ,ADDER) 
IMPLICIT NONE 
INCLUDE ‘CNA2:(CORLISSG. FORCE ]PARAMETERS. FOR’ 


INTEGER I, J, K, L, YEAR 


REAL OUTYEAR(OUTY+2,LOS,RATE+1 ,PROG+1), 
ADDER(LOS-2,PROG), INV(LOS-2,PROG), LAT(LOS-2,PROG) 


Initializing 


DO 10 I=1,LOS-2 
DO 10 J=1,PROG 
INV(I,J) = @.2 
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DO 15 K=1,PROG 
DO 15 J=1,RATE 
15 INV(1,K) = INV(1,K) + OUTYEAR(YEAR,1,J,K) 
DO 20 K=1,PROG 
DO 20 J=i,RATE 
DO 2@ I=3,LOS-1 
20 INV(I-1,K) = INV(I-1,K) + OUTYEAR(YEAR,1I,J,K) 
Cssoec see SSeS 
DO 30 K=1,PROG 
DO 3@ I=1,LOS-2 
IF ((1 .LT. 10) .OR. (K .E€Q. 1)) THEN 
ADOER(I.K) = INV(I,K) © LAT(I.K) 
END IF 
3a CONTINUE 
(See 
RETURN 
END 
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This subroutine will take the inventory created in the simulation 
and break it out by PAYGRADE so it can be compared to requirements. 


Toye ode KS ee iM These are used as indexes into 
arrays. 


OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1) This array will be passed into the 
subroutine and it contains the 
simulated outyear inventories. 


PAYGRADE(LOS, RATE, PROG,PAYG) This array will be read into the 
subroutine and it contains the percents 
to show how poygrade is to be broken 
out of the inventory. Each outyear 


of the inventory uses the same breakout. 


SUM(OUTY,RATE,PAYG) This array will be used to store the 
new inventory by RATE, PAYGRADE and 


this is passed out of the subroutine 
to be used to compare to requirements. 


SUBROUTINE ADOD_PAYGRADE(OUTYEAR, SUM) 
IMPLICIT NONE 


INCLUDE ‘CNA2:([CORLISSG. FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE *CNA2:[CORLISSG. FORCE ]PARAMETERS. FOR’ 


INTEGER I, J, K, L, M 


REAL OUTYEAR(OUTY+2,LOS,RATE+1,PROG+1), 
PAYGRADE(LOS,RATE,PROG,PAYG), SUM(OUTY,RATE,PAYG) 


CALL DISPLAY(13,15, Beginning to add paygrade to outyear inventories’, 
SK,SK,SK) 


OPEN (UNIT=56,READONLY,STATUS=' OLD‘, FORM=’UNFORMATTED’, 
FILE=‘CNA2:[CORLISSG.FORCE.DAT]PAYGRADE.DAT') 

READ(56) PAYGRADE 

CLOSE(UNIT=56) 


DO 10 M=t,PAYG 
DO 1@ L#1,PROG 
DO 1@ K=1,RATE 
DO 1@ J=1,L0S 
DO 1@ I=3,OUTY+2 
SUM(I-2,K,M) = SUM(I-2,K,M) + (OUTYEARCI.J,K,L) © PAYGRADE(J,K,L,M)) 


CALL DISPLAY(14,15,’Finished adding paygrade to outyeor inventories’, 
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ws 


RETURN 
END 
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This subroutine is used to write out to the screen and to a disk ie 

. file the results of the simulation. The simulated results will ey 
be compared to the NAVY requirements. wd 

x 

RATING_INDEX(RATE) This array is used to store which m 

% ratings the user has selected to view . 
2 on the terminal. z, 
NUM_RATING This is a count of how many ratings the 4 

id 


user selected to view. 


7 


a 


Dyk 2b These variables ore used as indexes 
into arrays. 


OUT This stores the year that the user 
selected for viewing on the terminal. 


£IF VSAAD IIA 


NUM_C (OUTY) This is passed into the subroutine and 
it contains the counts for the number 
of ratings changed for each outyear. . 
‘ 
‘ 
CHANGED(OUTY,RATE) This array stores the ratings that were : 
changed for each outyear. \ 
» 
CNTR This is used to compute how many z 


positions to zero out in certain arrays. 


CNT This is used to keep a count of where 
a poge break is needed in the output. 


REQ(2@,RATE,PAYG) This array is read into the program in 
this subroutine and it contains the 
NAVY requirments. 


SUM(OUTY,RATE, PAYG) This array is passed into this 
subroutine and it contains the 


simulated results for each outyear by 
Rate and Paygrade. 


S(OUTY+1,RATE+1 , PAYG+1) This array is the same as SUM except 
that Totals have been added. 


aie ee aS ln ce ie i i i ie a a 


SR(OUTY+1,RATE+1 , PAYG+! ) This array is the same as REQ except 
that Totals have been added. 


DIFF (OUTY+1,RATE+1,PAYG+1) This array is computed by subtracting 
SR from S in each cell. 


RATIO(OUTY+1,RATE+1 , PAYG+1) This orray is computed by dividing 
DIFF by SR at every cell where SR > 0.0 
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LOS_1(OUTY,RATE+1 , PROG+1 ) This array is passed into this 
subroutine and it contains the original 
LOS 1 allocation of new recruits for 
each of the outyears. 


LOS_1_C(OUTY,RATE+1,PROG+1) This array is passed into this 
subroutine and it contains the original 
LOS 1 allocation except where the user 
has changed a Rating or Program mix. 


YEAR_SEL*#2 This is passed into the subroutine 
and it contains the year for the 
transitions that the user selected. 


SUBROUTINE WRITEIT(SUM,NUM_C,CHANGED, YR_SEL,LOS_1,LOS_1_C,LOSSES) 
IMPLICIT NONE 


INCLUDE ‘CNA2:[CORLISSG.FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE ’CNA2:[CORLISSG.FORCE]PARAMETERS.FOR’ 


INTEGER RATING_INDEX(RATE), NUM_RATING 


INTEGER I, J, K, L, OUT, REQ(28,RATE,PAYG), NUM_C(OUTY), 
CHANGED(OUTY,RATE), CNT, CNTR 


REAL SUM(OUTY,RATE,PAYG), DIFF(OUTY+1,RATE+1,PAYG+1), 
RATIO(OUTY+1, RATE+1 , PAYG+1) ,S(OUTY+1,RATE+1, PAYG+1), 
SR(OUTY+1,RATE+1,PAYG+1), LOSSES(OUTY,RATE,PROG-3), 
LOS_1 (OUTY, RATE+1,PROG+1), LOS_1_C(OUTY, RATE+! ,PROG+1) 


PARAMETER(CNTR=(OUTY+1) ©(RATE+1) © (PAYG+1) ) 
CHARACTER HOLD, ANS, FLAG 
CHARACTER#*2 YR_SEL 


CHARACTER*8& RATE_LABEL 


CHARACTER*#25 NAME 
CHARACTER*29 FILEN 


DATA S/CNTR*@.0/,SR/CNTR*O.0/,DIFF/CNTR*O.0/,RATIO/CNTR#@.0/ 

CALL DISPLAY(16,15,’Beginning to write results to disk’,BO,SK,SK) 

OPEN(UNIT#50,FILE='CNA2: [CORLISSG.FORCE.DATJREQ.DAT’, 
FORM='UNFORMATTED’ ,READONLY,STATUS='OLD’ ) 


READ(5@) REQ 
CLOSE (UNI T=50) 


The 18 loops will sum up everything needed 


DO 18 K=1,PAYG 
DO 10 J=i,RATE 
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0O 18 I=1,0UTY 


S(I,J,K) = S(1,J,K) + SUM(I,J,K) 
S(1,RATE+1,K) = S(1,RATE+1,K) + SUM(I,J,K) 
S(1,J,PAYG+1) = S(1,J,PAYG+1) + SUM(I,J,K) 
S(OUTY+1,JU,K) = S(OUTY+1,J,K) + SUM(I,J,K) 
S(OUTY+1,RATE+1,K) = S(OUTY+1,RATE+1,K) + SUM(I,J,K) 
S(1,RATE+1,PAYG+1) = S(1,RATE+1, PAYG+1) + SUM(I,J,K) 
; S(OUTY+1,U,PAYG+1) = S$ (OUTY+1,J,PAYG+1) + SUM(I,J,K) 
S(OUTY+1,RATE+1,PAYG+1) = S(OUTY+1,RATE+1 ,PAYG+1) + SUM(I,J,K) 
SR(I,J,K) = SR(1,Jd,K) + REQ(I,J,K) 
* SR(I,RATE+1,K) = SR(1,RATE+1,K) + REQ(I,J,K) 
" SR(I1,J,PAYG+1) = SR(I,J,PAYG+1) + REQ(1,J,K) 
SR(OUTY+1,J,K) = SR(OUTY+1,U,K) + REQ(1,J,K) 
SR(OUTY+1,RATE+1,K) = SR(OUTY+1,RATE+1,K) + REQ(1,J,K) 
SR(I,RATE+1,PAYG+1) = SR(1,RATE+1, PAYG+1) + REQ(1,J,K) 
SR(OUTY+1,u,PAYG+1) = SR(OUTY+1,U,PAYG+1) + REQ(I,J,K) 
18 SR(OUTY+1,RATE+1,PAYG+1) = SR(OUTY+1,RATE+1,PAYG+1) + REQ(I,J,K) 
Cc ee ee ee re a a ww we we ww ee we wo we we ew wr wn ew we ww a we we oe ee ew ww www 
Cc The next section is for creating ao disk file that shows the 
c comparison of simulated results to requirements 
OPEN (UNIT=66,STATUS='NEW’ ,FILE='ACTIVE.DAT’) 
DO 2@ K=1,PAYG+1 
DO 20 J=m1,RATE+1 
, DO 20 I=1,OUTY+1 
OIFF(I,J,K) = S(I,uU,.K) - SR(I,J,K) 
IF (SR(I,J,K) .EQ. @) THEN 
RATIO(I,J,K) = 0.8 
ELSE 
RATIO(I,J,K) = DIFF(I,U,K) / SR(I,J,K) 
END IF 
20 CONTINUE 


DO 82 I=1,OUTY 
WRITE(66, 200) 
WRITE(66, 180) 
WRITE(66,190) I + (CFY - 1) 
WRITE(66, 180) 
WRITE(66, 182) 
WRITE(66,25@) 
WRITE(66,260) 
- WRITE(66, 220) 
WRITE(66, 260) 


DO 40 J=1,RATE+1 
FLAG =" ° 


DO 3@ L=1,NUM_C(I) 
IF (CHANGED(I,L) .£Q. J) THEN 
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32 CONTINUE 


WRITE (66 


40 CONTINUE 
CNT = 60 
DO 60 J=#1,RATE 
CNT = CN 


IF (CNT 


CNT = 1 
ENO IF 
c 
C SKIPING PAYGRADE WRITEOUT FOR EACH RATING 
c 
C IF (CNT .NE. 1) THEN 
6 WRITE(66, 180) 
c END IF 
c 
c DO 5@ K=1,PAYG 
€ WRITE(66,170) RATE_LABEL(J), S(I, 
c * SR(I,u,K), DIFF(I,u,K), 
C5@ CONTINUE 
c 
¢ WRITE (66,180) 
WRITE(66,17@) RATE_LABEL(J), S(I,u,PAYG+1), 
. SR(I,d;PAYG+1), DIFF(I,u,PAYG+1), 
* RATIO(1.J,PAYG+1) 
6Q CONTINUE 
WRITE(66, 18) 
DO 70 K=1,PAYG 
WRITE(66,170) ‘OUTY PG °,S(I,RATE+1,K),SR(1,RATE+1,K), 
. DIFF(I,RATE+1,K), RATIO(I,RATE+1,K) 
78 CONTINUE 
WRITE(66,18@) 
WRITE(66,170) ‘TOTAL OY’, S(I,RATE+1,PAYG+1), 
° SR(1,RATE+1,PAYG+1), DIFF(I,RATE+1,PAYG+1), 
° RATIO(I,RATE+1,PAYG+1) 
Be CONTINUE 


ee OO ee eee oe ae ee ee re aa = 


FLAG = ‘a’ 
END IF 


,230) RATE_LABEL(J), 
(LOS_t(1I,0.K),K=1,PROG41), 
(LOS_1_C(I,J,K),K=1,PROG+1), FLAG 


T+ 1 


.GT. 52) THEN 
WRITE(66, 200) 
WRITE(66, 180) 
WRITE(66, 272) 
WRITE(66, 180) 
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WRITE(66, 180) 
DO 9@ K=1,PAYG 
WRITE(66,17@) ‘TOT PG °, S(7,RATE+1,K), SR(7,RATE+1,K), 
DIFF(7,RATE+1,K), RATIO(7,RATE+1,K) 


CONTINUE 
WRITE(66, 180) 
WRITE(66,178) ‘TOT TOT ', S(OUTY+1,RATE+1,PAYG+1), 


SR(OUTY+1,RATE+1,PAYG+1), DIFF(OUTY+1,RATE+1,PAYG+1), 
RATIO(OUTY+1, RATE+1, PAYG+1) 


CLOSE (UNIT=66) 


CALL DISPLAY(17,15,’Finished writing results to disk’,BO,SK,SK) 


Writing out the sums of the simulated results to disk for use in the 


Compare program. 


CALL DISPLAY(19,5,’Enter a filename for storing the resuits’, 
SK,SK,SK) 

CALL DISPLAY(19,46,'(For use jater in the Compare run)’,SK,SK,SK) 

CONTINUE 

NAME = ’ 

CALL ACCEPT(21,20,NAME,BO,NE,SK) 


IF (NAME .EQ. ° ') THEN 
GOTO 100 

END IF 

FILEN = ‘ACT_'//NAME 


OPEN (UNIT=67,STATUS=’NEW’ , FILE=FILEN, FORM='UNFORMATTED’ , ERR=10@) 
WRITE(67) S 
CLOSE (UNIT=67) 


FILEN = 'LOS_'’//NAME 


Write out LOSSES to be used by RESERVE simulation. 


OPEN(UNIT#67,STATUS='NEW’ ,FILE=FILEN, FORM=™’UNFORMATTED’ ) 
WRITE(67) LOSSES 
CLOSE(UNIT=67) 


FORMAT(4X,A8,4F17.3) 
FORMAT(1X) 
FORMAT(55X,"Y E AR ',14) 


FORMAT('1') 

FORMAT(4@X,'eeseeese8 No Rating Mixes were changed seseeee0') 
FORMAT(11X,°' 4 YO °’,’ Act Ma’,’ 5&6Y0’,° Prior’,’ Tars’, 
" Sea C’,° Other’," Totol®, 3%. 4° .2x, 

* 4 YO *," Act Ma’,’ 5&6Y0’,* Prior’,’ Tors’, 
" Sea C',’ Other’,’ Totai’) 
FORMAT(1X,A8,2X,8F7.@,3X,°|°,2X,8F7.0,1X,A1) 


FORMAT(4@X,' (Transition Rates for Fiscal Year ',A2,° were used)') 
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FORMAT(23X,'0 RI GINA L’,32xX,’[',25X,,C HANG E D0’) 


FORMAT(70X,"|°) 
FORMAT(12X,° 
CONTINUE 

CALL CHANGE_SCREEN(CL,SK, SK) 


RETURN 
END 


Simulated’, 
y Difference’, 
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ANNEX D-3 


LISTING OF RESERVE (SELRES) SIMULATION PROGRAM 


| aK NAS A og RN ew TOES 


(VAX-11 FORTRAN) 


we ait a a ete ee aml ee PP mm ee 8 me ~~ 


AAPL heey tit 


i ae es 


a 


WP 


aw 


[e; we ee ae ae ee a a a a a a a a a a a a a a oe ee 
c 
c BNE ST Mi NLT PROGRAMS S I MULATION 
Cc RES ER: VE (S ELRE S$) PROGRAM 
c 
Cc wee ee a a a a a = a a a wn on = = nn a a a a = = a a an a a a a a a rw a ee wr eee 
c 
c This program is set up to accept inputs vio the terminal for 
c Reserve recruits in the SAMS and OTHER programs. This program 
; Cc olso reads in the Active simulation losses {or use in the 
c Reserve simulation. 
Cc 
. c SAMS (OUTY) This array is used to store the numbers 
‘ Cc input by the user for each outyear., 
c The numbers are for new SAM recruits. 
C 
OTHER(OUTY) This array contains The user inputs for 


new recruits into the OTHER program. 


This array will store the most recent 


year of history in the first outyear 


OUTYEAR(OUTY+1,LOS,#AIE,PROG) 


dimension. The other outyeor 
dimensions will be filled by 
simulating the history forward into 
the future. The LOS 1 will be filled 
by user inputs and Active simulation 
losses. 

LOSSES(OUTYEAR, RATE, PROG—2) This array will be read into the 


program and it contains the Active 
simulation losses for each outyear. 


This array is created after the OUTYEAR 
orrcy has been creoted. It will be the 
same cs OUTYEAR except thot it is 
collapsed over program and paygrode is 
added. It is used for comparing to 
requirements. 


SUM(OUTY,RATE,PAYG) 


This stores the filename of the Active 
loss file selected. Is used for 
displaying to the user. 


ACTFILE 


[20 22s 23 Ot oi OMe Ol ell el oll el oil elle ile iene i ole ilolelellellielia) 


Coos So Se Ce eee ae eae aa ee we See aaa eae eae eae eae eS Ses ae ea eee ee Se ee eee See ee eee 
IMPLICIT NONE 

Gessiounsecee cee oseea scot Se een cee tac sre CoS oS eee eae oS 

C The INCLUDE for Screen_Parometers.for contains the variables 
. C used for the screen handiing subroutines. They are: 

Cc 

Cc BE = 'BE' used to sound the beli 

c BL = ‘BL’ used to make the screen blink 
- Cc BO = 'BO’' used to make the screen bold 

C Cl. = 'CL’ used for clearing the screen 

Cc NE = '"NE’ used to make the screen negative 

c NO = 'NO’ used to set screen back to normal 

c SC = 'SC’' used to score (underline) data on screen 
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SK = ' " used to skip an option. 


The INCLUDE for Parameters_Res.for contains the variables 
to show how the Arrays should be dimensioned. They are: 
LOS = 8 There are 8 LOS’s in the Reserves 
RATE = 69 There are 69 Ratings 
PROG = 6 There are 6 programs in the Reserves 
PAYG = 9 There are 9 poygrades 
OUTY = 18 There are 10 outyears for this simulation 


INCLUDE ‘CNA2:[CORLISSG.FORCE]PARAMETERS_RES.FOR' 


INTEGER SAMS(OUTY), OTHER(OUTY) 


REAL OUTYEAR(OUTY+1,LOS,RATE,PROG), SUM(OUTY,RATE,PAYG), 
. LOSSES(OUTY,RATE,PROG-2), 


CHARACTER HOLD, ANS 
CHARACTER*®5@ ACTFILE 


ALLOC_SAMS(RATE) 


OPEN (UNIT#6,STATUS='OLD’ ,RECL=500) 
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CALL CHANGE_SCREEN(CL,SK.SK) 

CALL DISPLAY(1@,15,’R ES ERVE FOR ¢ E SMM OS GALT Oo Ni: 
* BO,SK.SK) 

CALL DISPLAY(22,25.'HIT RETURN TO START RUN’,SK,SK,SK) 

CALL ACCEPT(22,49,HOLD,SK,SK,SK) 

CALL GET_LOSSES(LOSSES,ACTFILE) 

CALL ACCEPT_OUTYEAR_RECRUITS(OUTYEAR,SAMS,OTHER, LOSSES) 

CALL CHANGS M'YES(OUTYEAR) 

CALL TRANSISTION(OUTYEAR) 

CALL ADD_PAYGRADE(OUTYEAR, SUM) 

CALL WRITE_RESULTS(SUM, SAMS, OTHER, LOSSES ,ACTFILE) 

CALL CHANGE_SCREEN(CL,SK.SK) 

CALL DISPLAY(1@,20, FINISH OF RESERVE FORCE SIMULATION’ ,BO,SK,SK) 

CALL DISPLAY(23,25,'°HIT RETURN TO FINISH’,SK,SK,SK) 


CALL ACCEPT(23,49,HOLD,SK,SK,SK) 
CALL CHANGE_SCREEN(CL,SK,SK) 
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c S, (U) Bethe OU! oh? BON: IE GET L/OrS 8S. JES 

tes 

G28 S2S222 ae See et ee eh ee es ee ee aoe ee ee ee eo ee eS eee 
c 

Cc This subroutine reads in ao user selected Active loss 

c the loss file along with the filename out of the 

c 

Cc LOSSES(OUTY,RATE,PROG-2) This file contains 

Cc for a specific run 

c selected to use. 

c 

c FILEN Has the filename of 

Cc loss file that is to be opened. 

Cc 

c ACTFILE This is the filename to display 

Cc the user. 

GStesbe sees o seete Soe oS eS Se eee eS Se eas SSeS ee See 


SUBROUTINE GET_LOSSES( LOSSES ,ACTFILE) 
IMPLICIT NONE 


INCLUDE ‘CNA2:(CORLIESG.FORCEJPARAMETERS_RES.FOR’ 


INCLUDE 'CNA2:[CORLISSG.FORCEJSCREEN_PARAMETERS.FOR’ 


REAL LOSSES(OUTY,RATE,PROG-2) 


CHARACTER HOLD 
CHARACTER*50 FILEN, ACTFILE 


CALL FIND_ACTIVE_LOSS_FILES(FILEN,ACTFILE) 


OPEN(UNIT#50,STATUS='OLD’ ,FILE=FILEN,FORM=’UNFORMATTED’, 


* READONLY ) 
READ(5@) LOSSES 
CLOSE(UNIT#=50) 


RETURN 
END 
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This subroutine is used to allow the user to select any previously 


created Active loss matrix. The subroutine searches the 
users directory for loss files and displays to the terminal the 
choices. If no choices ore availoble, execution of this program 


is terminated. 


FILEN This is passed back to the main 
program and it contains the filename 
of the users choice or ‘FLAG’. 


NEWFILE This is used in the tibrary cail and 
it contains the next file found in the 
directory. When no more files it 
posses back the default filename. 


These are used by the !ibrary and are 
used to locate a certain set of files. 


DEFAULT, RELATED, FILENAME 


STORE( 100) This is used to store the names of all 
the user created allocations found 
in the directory. 


D1IS(100) This stores the names of the files to 
be displayed to the user on the screen. 


CHECK Is used to check and see when there are 
no more files. 


CONTEXT Is used by the iibrary subroutine as an 
address pointer and must be set to Q@ 
ot start. 


ROW, ROW! Used to calculate which row of the 
screen to display on. 


BEGIN, END Used to store the begin ond end of 
strings that are being seorched for in 
other strings. 

NUMFILES Is ao counter used to keep count of the 
of allocations found in the directory. 

ANS The answer to which allocation the user 
selected to use. 

1, O.FF Used as integers for loops and 


calculations. 


SUBROUTINE FIND_ACTIVE_LOSS_FILES(FILEN,ACTFILE) 


IMPLICIT NONE 
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INCLUDE "CNA2 [CORLISSG. FORCE]SCREEN_PARAMETERS. FOR’ 


INTEGER CONTEXT, ROW, ROW1, BEGIN, END, NUMFILES, ANS, I, 


CHARACTER HOLD 


CHARACTER*®5Q FILENAME, NEWFILE, DEFAULT, RELATED, FILEN, 
STORE(10@), DIS(10@), CHECK, ACTFILE 


CALL CHANGE_SCREEN(CL,SK,SK) 
FILENAME = ‘LOS_*.DAT' 


DEFAULT = FILENAME 
RELATED = FILENAME 


CONTEXT = @ 
NUMFILES = 1 


CHECK = 


CONTINUE 


DIFF 


CALL LIBSFINO_FILE(FILENAME,NEWFILE,CONTEXT,DEFAULT,RELATED) 


BEGIN = INDEX(NEWFILE,']LOS_") 
END = INDEX(NEWFILE,'.DAT’) 
BEGIN = BEGIN + 1 

END = END + 3 

OIFF = (END - BEGIN) + 1 


CHECK(1:O1FF) = NEWFILE(BEGIN: END) 
DIS(NUMFILES) = CHECK(5:DIFF-4) 


IF (CHECK .NE. FILENAME) THEN 
IF (NEWFILE .NE. STORE(NUMFILES)) THEN 
STORE(NUMFILES) = NEWFILE 
NUMFILES = NUMFILES + 1 
END IF 
CHECK = ' 
GOTO 10 
END IF 


NUMFILES = NUMFILES - 1 


IF (NUMFILES .EQ. @) THEN 
CALL CHANGE_SCREEN(CL,SK,SK) 


CALL DISPLAY(12,10,° Cannot run Reserve simulation yet.', 


BO,SK,SK) 


CALL DISPLAY(14,1@,'You need to run an Active simulation first. 


BO,SK,SK) 
CALL DISPLAY(14,54,'<Hit Return>’,BO,SK,SK) 
CALL ACCEPT(14,66,HOLD,SK,SK,SK) 
STOP 
END IF 
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ROW = @ 
ROW] = @ 


DO 2@ I=1,NUMFILES 
IF (NUMFILES .GT. 10) THEN 
ROW = ROW + 1 
ELSE 
ROW = ROW + 2 
END IF 


IF (I .GT. 20) THEN 
ROW. = ROW] + 1 
CALL DISPLAY_INTEGER(ROW1,46,1,3,80,SK,SK) 
CALL DISPLAY(ROW1,5@,°-',SK,SK,SK) 
CALL DISPLAY(ROW1,52,DI1S(1I),.SK,SK,SK) 


ELSE 
CALL DISPLAY_INTEGER(ROW,10,1,3,B80,SK,SK) 
CALL DISPLAY(ROW,14,'-',SK,SK,SK) 
CALL DISPLAr(ROW,16,DI1S(1I),SK,SK,SK) 

END IF 


CONTINUE 
CALL DISPLAY(23,10,'’Select Active toss file to use:’,SK,SK,SK) 


CONTINUE 
CALL ACCEPT_INTEGER(23,42,ANS,2,B0,SC, SK) 


IF (ANS .LT. 1 .OR. ANS .GT. NUMFILES) THEN 
CALL DISPLAY(23,45,’Invalid input <Hit Return>’,BO,NE,BE) 
CALL ACCEPT(23,72,HOLD,SK,SK,SK) 
CALL DISPLAY(23,45,° SK SK GK) 
GOTO 3e 

END IF 


FILEN = STORE(ANS) 
ACTFILE = DIS(ANS) 


CONTINUE 


RETURN 
END 
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SUBROUTINE ACC. ER eT OU TY <B AR REC LRU IES. 


This subroutine is set us to ailow the user to input via the terminal 
the new recruits for the SAM program and the OTHER program for each of 
the outyears. Also, the Active simulation losses will be reod into 


the program. 


ROW, I, J, K, START, FINISH These variables are used as indexes 
into arrays and as pointers to 
positions on the terminal. 


SAMS(OUTY) This orray is used to store the numbers 
input by the user for each outyeor. 
The numbers are for new SAM recruits. 


OTHER(OUTY) This array contains the user inputs for 
new recruits into the OTHER program. 


FLAG This is used for flagging whether the 
user is inputting for SAMS or OTHER's 


OUTYEAR(OUTY+1,LOS,RATE, PROG) This array will store the most recent 
yeor of history in the first outyeor 
dimension. The other outyear dimensions 
will be filled by simulating the 
history forward into the future. This 
subroutine will be used for filling in 
the LOS 1 for each outyear. 


LOSSES (OUTYEAR, RATE, PROG-2) This array will be read into the 
program in this subroutine and it 
contains the Active simulation losses 
for each outyeoar. 


ALLOC(RATE, PROG~2) This array will be read into this 
subroutine and it contains the percents 
to show how active losses affiliate 


into the reserves. 


ALLOC_SAMS (RATE) This array is read in this subroutine 
and it contains the percents to show 
how user inputed SAM’s allocate over 
ratings. 


ALLOC_OTHER(RATE) This array is read in this subroutine 
and it contains the percents to show 


how user inputted OTHER are ailocated 
over ratings. 


SUBROUTINE ACCEPT_OUTYEAR_RECRUITS(OUTYEAR, SAMS ,OTHER,LOSSES) 


IMPLICIT NONE 
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INCLUDE 
INCLUDE 


INTEGER 


"CNA2: [CORLISSG.FORCE]SCREEN_PARAMETERS. FOR’ 
"CNA2: [CORLISSG. FORCE ]PARAMETERS_RES. FOR’ 


Row, I, J, K, START, 


FLAG, ANS 


FINISH, SAMS(OUTY), OTHER(OUTY), 


REAL ALLOC(20,RATE,PROG-2), ALLOC_SAMS(2@,RATE), 


ALLOC_OTHER(20,RATE), 


LOSSES(OUTY,RATE,PROG-2), 


OUTYEAR(OUTY+1,LOS,RATE,PROG) 


CHARACTER HOLD 


CHARALCTE 
CHARACTE 


Re2 CHAR_NUM 
Re8 RATE_LABEL 


CHARACTER*50 FILEN 


OPEN (UNI T#51,STATUS=’OLD’ ,READONLY,FORM='’UNFORMATTED', 
FILE='CNA2:[CORLISSG.FORCE.DAT_RESJALLOC_RES.DAT') 


READ(51) 
CLOSE (U 


CONTINUE 


ALLOC, ALLOC_SAMS, 


NIT=51) 


CALL CHANGE_SCREEN(CL,SK,SK) 


ALLOC_OTHER 


CALL DISPLAY 1@,15,'1°,BO,SK,SK) 


CALL DIS 


CALL OIS 
CALL OIS 


CALL DISPLAY(15,20,’Enter your 


CONTINUE 


FILEN = 


PLAY(1@.16,’ - Use the default SAM allocation’ 
SK,SK,SK) 

PLAY(12,15,°2',B0,SK,SK) 

PLAY(12,16,' -— Select ao user created SAM allocation’, 
SK ,SK,SK) 


selection',SK,SK,SK) 


CALL ACCEPT_INTEGER(15,42,ANS,1,B0,SC,SK) 


IF (ANS 


ELSE IF 
END IF 
IF (FILE 


ELSE IF 


END IF 


FLAG = @ 


-NE. 1° .AND. ANS 


NE. 


2) THEN 


CALL DISPLAY(15.45,'Invalid input <Hit Return>’,BO,NE,BE) 
CALL ACCEPT(15,71,HOLD,SK,SK,SK) 
CALL DISPLAY(15,45,' 


GOTO 3 
(ANS .EQ. 2) THEN 


"SK SK ISK) 


CALL FIND_SAM_ALLOCATION_FILES(FILEN) 


N .EQ. ‘FLAG') THEN 


GOTO 1 
(ANS .E£Q. 2) THEN 


OPEN (UNIT#=51,STATUS=’OLD’ , READONLY, FILE=FILEN, 
FORM='UNFORMATTED’ ) 
READ(51) ALLOC_SAMS 


CLOSE (UNIT#=51) 
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CONTINUE 
CALL CHANGE_SCREEN(CL,SK,SK) 


IF (FLAG .EQ. @) THEN 
CALL DISPLAY (8,2,’INPUT FOR SAMS’ ,BO,NE,BL) 


ELSE 
CALL DISPLAY (8,2, ’ INPUT FOR OTHERS',BO,NE,BL) 


END IF 


ROW = 2 
I= 1 


CALL DISPLAY_INTEGEF(ROW,19,1,2,B0,SK,SK) 


CALL DISPLAY(ROW,2*,"' — Current FY’,SK,SK,SK) 
CALL DISPLAY(ROW,34,' Total Recriuts:’,SK,SK,SK) 
CALL DISPLAY(ROW, 51,’ *,BO,SC,SK) 


DO 18 [=2,O0UTY 
IF (OUTY .GT. 10) THEN 
ROW = ROW + 1 
ELSE 
ROW = ROW + 2 
END IF 
CALL DISPLAY_INTEGER(ROW,19,1,2,80,SK,SK) 
CALL DISPLAY(ROW,21,° - Outyear’,SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW,32,1-1,2,SK,SK,SK) 
CALL DISPLAY(ROW,34,' Tota! Recriuts:'’,SK,SK,SK) 
CALL DISPLAY(ROW,51,’ *,BO,SC,SK) 
CONTINUE 


IF (OUTY .GT. 18) THEN 


ROW = 1 
ELSE 

ROW = Q@ 
END IF 
START = 1 


FINISH = GUTY 
CONTINUE 
DO 30 I=START,FINISH 


IF (OUTY .GT. 1) THEN 
ROW = ROW + 1 


ELSE 
ROW = ROW + 2 
END IF 
CALL DISPLAY(ROW,51,’ *,BO,SC,SK) 


IF (FLAG .£Q. @) THEN 
SAMS(1) = @ 
CALL ACCEPT_INTEGER(ROW,51,SAMS(I),6,B0,SC,SK) 
ELSE 
OTHER(1) = @ 
CALL ACCEPT_INTEGER(ROW,51,OTHER(1),6,80,SC,SK) 
END IF 
CONTINUE 
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CONTINUE 
CALL CHA 
IF (FLAG 
BESE 

END IF 


ROW = 2 
I = 1 


CALL DIS 
CALL DIS 
CALL DIS 
CALL DIS 


DO 10 |= 


CONTINUE 
IF (OUTY 
ELSE 

END IF 


START = 
FINISH = 


CONTINUE 


DO 3¢@ I= 


CONTINUE 


NGE_SCREEN(CL,SK,SK) 


.EQ. @) THEN 
CALL DISPLAY (8,2,' INPUT FOR SAMS’ ,BO,NE,BL) 


CALL DISPLAY (8,2,’° INPUT FOR OTHERS’ ,BC,NE,BL) 


PLAY_INTEGER(ROW,19,1,2,B0,SK,SK) 
PLAY(ROW,21,° - Current FY',SK. SK ,S*) 
PLAY(ROW,34,° Totaot Recriuts: ' ,SK,SK,SK) 
PLAY(ROW,51,' *,BO,SC,SK) 

2,0UTY 


IF (OUTY .GT. 10) THEN 
ROW = ROW + 1 
EuS'E 
ROW = ROW + 2 
END IF 
CALL DISPLAY_INTEGER(ROW,19,1,2,B0,SK,SK) 
CALL DISPLAY(ROW,21,° - Outyear’,SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW,32,1-1,2,SK,SK,SK) 
CALL DISPLAY(ROW,34,' Toto! Recriuts:’,SK,SK,SK) 
CALL DISPLAY(ROW,51,’ *. BOSC SK) 


.GT. 1@) THEN 
ROW = 1 
ROW = @ 


1 
OUTY 


START, FINISH 
IF (OUTY .GT. 1@) THEN 
ROW = ROW + 1 


ELSE 
ROW = ROW + 2 
END IF 
CALL DISPLAY(ROW,51,' *,B0,SC,SK) 


IF (FLAG .EQ. @) THEN 

SAMS(I) = @ 

CALL ACCEPT_INTEGER(ROW,51,SAMS(1),6,B0,SC, SK) 
ELSE 

OTHER(I) = @ 

CALL ACCEPT_INTEGER(ROW,51,OTHER(1I).6,B0,SC, SK) 
END IF 
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CALL DISPLAY(22,14, ENTER NUMBER OF OUTYEAR TO CHANGE OR <RETURND>’ 
,SK,SK,SK) 


CALL DISPLAY(22,6@,° *,BO,.SC,SK) 
CALL ACCEPT_INTEGER(22,6@,START,2,B0,50,SK) 


IF ((START GT. @) .AND. (START .LE OUTY)) THEN 
IF (OUTY .GT. 1@) THEN 
ROW = START 
ELSE 
ROW = (START - 1) # 2 
END IF 


FINISH = START 


GOTO 28 
ENO IF 


IF (FLAG .EQ. ®) THEN 
FLAG = 1 
GOTO 5 

END IF 


DO 4@ J=1,RATE 
DO 40 I=2,0UTY+1 


LOSSES(I-1,0,1) * ALLOC(1,J,1) 
LOSSES(I-1,JU,2) » ALLOC(I,J,2) 


OUTYEAR(I,1,J,1) 
OUTYEAR(I,1,J,2) 


OUTYEAR(1,1,,5) 
OUTYEAR(1,1,7,6) 


(SAMS(I-1)* @.9) * ALLOC_SAMS(I,J) 
(OTHER(I-1)* @.9) * ALLOC_OTHER(I,J) 


CONTINUE 
CALL CHANGE_SCREEN(CL,SK,SK) 


RETURN 
ENO 
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SUBROUTINE Be G1 Ne 30 


This subroutine ts used 


created and saved SAM allocotion matrix 


users directory for 


choices. If 

FILEN 

NEWFILE 

DEFAULT, RELEATED, FILENAME 


STORE( 120) 


D1S(10@) 


CHECK 


CONTEXT 


ROW, ROW! 


BEGIN, “ND 


NUMFILES 


ANS 


a a a oA re a 


to allow the user 


allocation 
no choices are to be had, 


AL tO @ SA Til (ON FoI 


to select any previously 
The subroutine searches the 
the terminal the 
in FiLEN. 


files ord displays to 
"FLAG’ is put 


This is passed back to the main program 
and it contains the filename of the 
users choice or ’'FLAG’. 

This is used in the library cail and 

it contcins the next file fuund in the 


directory. When no more files it 


passes back the default filename. 


These are used by the tibrary and ore 


used to locate a certian set of files. 


This is used to store the names of ait 


the user created allocations found 
in the directory. 
This stores the nomes of the files to 


be displayed to the user on the screen. 


Is used to check and see when there ore 
no more files. 


library subroutine as an 
be set to @ 


Is used by the 
address pointer and must 
at start. 

row of the screen 


Used to caic. which 


to display on. 


Used 
strings that 
other strings. 


the begin and end of 
ore being searched for in 


to store 


to keep count of the 
in the directory. 


used 
found 


Is a counter 
of allocations 
The answer to which allocation the user 
selected ‘o use. 


Used os intege:s for loops and 


calcuiations. 


SUBROUTINE FINO_SAM_ALLOCATION_FILES(FILEN) 


IMPLICIT NONE 
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INCLUDE ‘CNA2:[CORLISSG FORCE ]SCREEN_PARAMETERS.FOR' 
INTEGER CONTEXT, ROW, ROW!, BEGIN, END, NUMFILES, ANS, I, DIFF 
CHARACTER HOLD 


CHARACTER*5@ FILENAME, NEWFILE, DEFAULT, RELATED, OLOFILE, 
STORE(10@), DIS(10@), CHECK, FILEN 


CALL CHANGE_SCREEN(CL,SK,SK) 
FILENAME = 'SAM_*.DAT’ 


DEFAULT = FILENAME 
RELATED = FILENAME 


CONTEXT = @ 
NUMFILES = 1 


CHECK = ' 
CONTINUE 
CALL LIBSFINO_FILE(FILENAME,NEWFILE,CONTEXT, DEFAULT, RELATED) 


BEGIN = INDEX(NEWFILE, *]SAM_*) 
END = INDEX(NEWFILE,’.DAT‘) 
BEGIN = BEGIN + 1 

END = END + 3 

DIFF = (END - BEGIN) + 1 


CHECK(1:O1FF) = NEWFILE(BEGIN: END) 
DIS(NUMFILES) = CHECK(5:DIFF-4) 


1F (CHECK .NE. FILENAME) THEN 
IF (NEWFILE .NE. STORE(NUMFILES)) THEN 
STORE(NUMFILES) = NEWFILE 
NUMFILES = NUMFILES + 1 
END IF 
CHECK = ’ 
GOTO 18 
END IF 


NUMFILES = NUMFILES - 1 


IF (NUMFILES .EQ. @) THEN 
CALL DISPLAY(10,10,'No user created allocations yet <Hit Return>’ 
,B0,BE,SK) 
CALL ACCEPT(10,55,HOLD,SK,SK,SK) 
FILEN = ‘'FLAG' 
GOTO 999 
ENO IF 


ROW = @ 
ROW! = @ 


DO 20 [=1,NUMFILES 
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IF (NUMFILES .GT 10) THEN 
ROW = ROW + 1 

ELSE 
ROW = ROW + 2 

END IF 


IF (1 .GT. 20) THEN 
ROW! = ROW! +1 
CALL DISPLAY_INTEGER(ROW1,46,1,3,80,SK, SK) 
CALL DISPLAY(ROW1,5@,’°-',SK,SK,SK) 
CALL DISPLAY(ROW1,52,D1S(1),SK,SK,SK) 


ELSE 
CALL DISPLAY_INTEGER(ROW,10,1,3,80,SK, SK) 
CALL DISPLAY(ROW,14,°-',SK,SK,SK) 
CALL DISPLAY(ROW,16,DIS(1),SK,SK,SK) 
END IF 
20 CONTINUE 


CALL DISPLAY(23,10,’Enter your selection: ’',SK,SK,SK) 


30 CONTINUE 
CALL ACCEPT_INTEGER(23,32,ANS,2,80,SC,SK) 


IF (ANS .LT. 1 .OR. ANS .GT. NUMFILES) THEN 
GOTO 32 

ENO IF 

FILEN = STORE(ANS) 


999 CONTINUE 


RETURN 
END 
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CSS Sr = ass aS Sea a a ee ee aS See see oe Se Se > 
Cc 4 
c SUR OU TPR © SHR N GE Wii x es “J 
c : 
Cm ne ee eee eee ¥ 
Cc This subroutine controls which year the user wants to change the > 
c SAM allocation. 
Cc . 
C I, J, K, ROW These variables ore used as indexes 
Cc into arrays and as pointers to 
Cc positions on the screen for displaying. 
: ~ oo 
C YEAR Holds the years the user has selected x 
C to work with. Index into arrays. 
Cc 
Cc DIS_YEAR Stores the years the user is working “, 
Cc with. For use in displaying to screen. y! 
C ) 
C DONE (OUTY) This matrix stores flags to indicate ™~ 
C which of the outyears have been worked 
Cc on. AN 
C « 
c OUTYEAR(OUTY+1,LOS,RATE,PROG) This matrix is storing the history and os 
Cc LOS 1 for each of the outyeors. This » 
Cc is the matrix that is changed by the os 
Cc user. ei 
ee : 
SUBROUTINE CHANGE_MIXES(OUTYEAR) " 
a 
IMPLICIT NONE if 
‘v 
INCLUDE 'CNA2:[CORLISSG.FORCEJSCREEN_PARAMETERS.FOR’ a 
INCLUDE 'CNA2:[CORLISSG.FORCE}JPARAMETERS_RES.FOR’ “sf 
Ma 
my 
INTEGER 1, J, K, YEAR, DIS_YEAR, ROW, DONE(OUTY) L) 
z 
REAL OUTYEAR(OUTY+1,LOS,RATE,PROG) iy 
a 
CHARACTER HOLD, ANS iW 


C First che 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
5 CONT 
CALL 
LE oC 


END 


ck to see if any changes ore required. 
CHANGE_SCREEN(CL,SK,SK) 


DISPLAY(13,18,'Would you tike to change Sam mixes (',SK,SK,SK) 


DISPLAY(13,46,’°Y*,BO,SK,SK) 
OISPLAY(13,47,’es or',SK,SK,SK) 
DISPLAY(13,53,'N’,BO,SK,SK) 
DISPLAY(13,54,°0)?',SK,SK,SK) 
INUE 
ACCEPT(13,58,ANS,B80,SC,SK) 
ANS .NE. 'N’ .AND. ANS .NE. ‘Y* .AND. 
ANS .NE. ‘y’) THEN 
GOTO § 
IF 
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changes then exit this subroutine. 


IF (ANS .EQ. 'N’ OR. ANS .EQ. ‘'n’) THEN 
GOTO 999 


CONTINUE 
CALL CHANGE_SCREEN(CL,SK,SK) 


ROW = 2 
I =1 


DIS_YEAR = CFY 


CALL DISPLAY_INTEGER(ROW,24,1]1,2,B0,SK,SK) 
CALL DISPLAY(ROW,27,'= Current FY',SK,SK,SK) 
CALL DISPLAY_INTEGER( ROW, 40,DIS_YEAR,4,SK,SK,SK) 
IF (DONE(1) .EQ. 1) THEN 

CALL DISPLAY(ROW,21,°X’,BO,NE,SK) 
END IF 


DO 20 1=2,0UTY 
DIS_YEAR = DIS_LYEAR + 1 


IF (OUTY .LE. 10) THEN 
ROW = ROW + 2 


ELSE 
ROW = ROW + 1 
END IF 
CALL DISPLAY_INTEGER(ROW,24,1,2,B0,SK, SK) 
CALL DISPLAY(ROW,27,’- Outyear’,SK,SK,SK) 


CALL DISPLAY_INTEGER(ROW,37,1-1,2,SK.SK,SK) 
CALL DISPLAY_INTEGER(ROW, 4@,01S_YEAR,4,SK,SK,SK) 
IF (DONE(1) .£Q. 1) THEN 
CALL DISPLAY(ROW,21,'X’,BO,NE,SK) 
END IF 
CONTINUE 


CALL DISPLAY(22,20,’Enter Your Selection or (’,SK,SK,SK) 
CALL DISPLAY(22,45,'99'°,80O,SK,SK) 
CALL DISPLAY(22,48,'to end): '.SK,SK,SK) 


CONTINUE 


Accept the year and check to see if good 
selection or finished. 


CALL ACCEPT_INTEGER(22,57,YEAR,2,B0,SC,SK) 


IF (YEAR .EQ. 99) THEN 
GOTO 999 

ELSE IF (YEAR .LT. 1 .OR. YEAR .GT. OUTY) THEN 
CALL DISPLAY(22,6@,'Bad input Hit Return',BO,NE,BE) 
CALL ACCEPT(22,8@,HOLD,SK,SK,SK) 


CALL DISPLAY(22,62@,' ’,SK,SK,SK) 
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GOTO 38 
END IF 


CALL CHANGE_SAM_MIX (YEAR. OUTYEAR,DONE) 
GOTO 18 
999 CONTINUE 
CALL CHECK_TO_SEE_IF_SAVE_NEW_ALLOC(OUTYEAR) 


RETURN 
END 
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This subroutine al 
Rating for the yea 
choose the Ratings 


YEAR, YR 


START, FINISH, ROW 


Bek 
CNT 

DIFF, NUM 
DONE(OUTY) 


ORIG(RATE+1) 


D(RATE+1) 


PROGRAMB(RATE+1) 


NUM_RATING 


RATING_ INDEX (RATE) 


OUTYEAR(OUTY+1,LOS 


UTINE 


lows the user to change the SAM allocation by 
r selected. In this subroutine the user will 


to work with. 


Used to store the year the user has 
selected to work with. Is passed to 
this subroutine. 


These acre used to compute where on the 
screen the cursor should be and to 
store which rating to work with. 

Used as indexes into arrays. 

Used to count the number of changes. 


Used in computing and displaying 


If a change is made then flog the 
change in the appropiate year 


Stores the way the SAMs are aliocated 
upon entering this subroutine. 


Will store the diffrences in changes 
made. Hos to = @ before exiting 
this subroutine. 


This is the matrix the user changes 
around. After finished this orray is 
used to update the OUTYEAR matrix. 


Hos the number of rating selected to 
work with. 


Stores the ratings the user selected 
to change. 


ls updated oat end of subroutine with 
the changes made. 


,RATE, PROG) 


C= ------- - - - - - - - - a a a a a eee eee 


SUBROUTINE CHANGE_ 
IMPLICIT NONE 


INCLUDE ‘CNA2:[COR 
INCLUDE ‘CNA2:[COR 


INTEGER YEAR, YR, 
CNT, DIFF, 


SAM_MIX(YR,OUTYEAR,DONE) 


LISSG.FORCEJ]SCREEN_PARAMETERS. FOR’ 
LISSG.FORCEJPARAMETERS_RES.FOR’ 


START, FINISH, I, J, K, ORIG(RATE+1), 
ROW, PROGRAMB(RATE+1), O(RATE+1). 
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* NUM, DONE(OUTY). NUM_RATING, RATING_INDEX(RATE) 
REAL OUTYEAR(OUTY+1,LOS,RATE,PROG) 
CHARACTER HOLD 
CHARACTER*®& RATE_LABEL 
CNT = Q 


YEAR = YR + 1 


C Calting this subroutine allows the user to select 


C the ratings to work with. 
CALL CHOOSE_RATING(RATING_INDEX, NUM_RATING) 


C Oniy 16 ratings can be worked with at one time. 
IF (NUM_LRATING .GT. 16) THEN 
NUM_RATING = 16 


END IF 
Casa o Ska ees oi ee Se ee eS ee eee oS 
START = 1 
FINISH = NUM_RATING 
ROW = 2 
G2 22a 22S eee ee Re eae ee eee eee 


C The first thing to do is store what the LOS 1 
C tooks like by RATING for the selected outyear. 
C The 1@ loop toads in LOS 1 and computes a total accession. 
ORIG(NUM_RATING+1) = @ 
PROGRAMB(NUM_RATING+1) = @ 
D(NUM_RATING+1) = @ 


DO 10 I=1,NUM_RATING 

ORIG(I) = @ 
PROGRAMB(I) = @ 
O(!1) = @ 
ORIG(I) = OUTYEAR(YEAR,1,RATING_INDEX(I1),5) + .5 
PROGRAMB(1I) = OUTYEAR(YEAR,1,RATING_INDEX(1),5) + .5 
ORIG(NUM_RATING+1) = ORIG(NUM_RATING+1) + ORIG(1) 

12 PROGRAMB(NUM_RATING+1) = PROGRAMB(NUM_RATING+1) + PROGRAMB(1) 


CALL CHANGE_SCREEN(CL,SK,SK) 


IF (NUM_RATING .GT. 8) THEN 
CALL DISPLAY (1,29,'Orig’.SC,SK,SK) 
CALL DISPLAY (:,4@, ‘Change’ ,SC,SK,SK) 
CALL DISPLAY (1,52, 'Diff’,SC,.SK.SK) 


ELSE 
CALL DISPLAY (2,29,'Orig’,SC,SK,SK) 
CALL DISPLAY (2,40, ‘Change’ ,SC,SK,SK) 
CALL DISPLAY (2,52, 'Diff’',SC,SK,SK) 
ENO IF 
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DO 2@ I=START,FINISH 
IF (NUM_RATING .GT. 8) THEN 
ROW = ROW + 1 
ELSE 
ROW = ROW + 2 
END IF 
CALL DISPLAY_INTEGER(ROW, 10,1,2,B0,SK,SK) 
CALL DISPLAY(ROW,13,RATE_LABEL(RATING_INDEX(I)),SK,SK,SK) 
CALL DISPLAY_INTEGER(ROW, 27,ORIG(I),6,80,SK,SK) 
CALL DISPLAY_INTEGER(ROW, 40, PROGRAMB(!),6,80,S5C,SK) 
CALL DISPLAY_INTEGER(ROW,5@,0(1),6,80,SK,SK) 
20 CONTINUE 


ROW = ROW + 2 

CALL DISPLAY(ROW,13,RATE_LABEL(RATE+1),SK,SK,SK) 

CALL DISPLAY_INTEGER(ROW, 27,ORIG(NUM_RATING+1),6,B0,SK,SK) 
CALL DISPLAY_INTEGER(ROW, 40, PROGRAMB (NUM_RATING+1),6,80,SC,SK) 
CALL DISPLAY_LINTEGER(ROW,5@,0(NUM_RATING+1),6,80,SK,SK) 


CALL DISPLAY(22,10, Enter Rating to change or <Return>:',SK,SK,SK) 


3@ CONTINUE 


CALL ACCEPT_INTEGER(22,47,START,2,B80,SC,SK) 


C After a RATING is selected to change the user inputs 
C the new number and the difference is computed and displayed. 
C if a change is made an equal change must be made in some other 
C RATING to offset it. 
IF (START .GT. @ .AND. START .LT. NUM_RATING+1) THEN 
CNT = CNT + 1 
IF (NUM_RATING .GT. 8) THEN 
ROW = 2 + START 
ELSE 
ROW = 2 + (START # 2) 
END IF 
NUM = PROGRAMB(START ) 
CALL ACCEPT_INTEGER( ROW, 40, PROGRAMB(START).,6,B0,SC,SK) 
D(START) = D(START) + (PROGRAMB(START) - NUM) 
D(NUM_RATING+1) = D(NUM_RATING+1) + (PROGRAMB(START) - NUM) 
PROGRAMB(NUM_RATING+1) = PROGRAMB(NUM_RATING+1) + 
° (PROGRAMB(START )—NUM) 
CALL DISPLAY_INTEGER(ROW,50,0(START),6,B80,SK,NE) 
IF (NUM_RATING .GT. 8) THEN 
ROW = 4 + NUM_RATING 
ELSE 
ROW = 4 + (NUM_RATING © 2) 
ENO IF : 
CALL DISPLAY_INTEGER (ROW, 4@, PROGRAMB(NUM_RATING+1),6,B80,SK,NE) 
CALL CISPLAY_INTEGER(ROW,50,D(NUM_RATING+1),6,B0,SK,NE) 
GOTO 38 


C If no changes were made then exit subroutine. 
IF (CNT .EQ. @) THEN 
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999 


40 


GOTO 999 
END IF 


DONE(YEAR-1) = 1 
DIFF = PROGRAMB(NUM_RATING+1) - ORIG(NUM_RATING+1) 


This IF statement is checking to moke sure thot before 

exiting the total is the same as when entering the subroutine. 

If not an error message is sent to the user and more changes 

must be made. 

IF (DIFF .GT @ .OR. DIFF .LT. @) THEN 

CALL DISPLAY(23,10,'The Tota! has to =’,B0O,NE,BE) 
CALL DISPLAY_INTEGER(23,29,ORIG(NUM_RATING+1),6,80,SC,SK) 
CALL DISPLAY(23,36,'not’,BO,NE,SK) 
CALL DISPLAY_INTEGER(23,4@,PROGRAMB(NUM_RATING+1),6,80,SC,SK) 
CALL DISPLAY(23,49,'<Hit Return>',80,NE,SK) 
CALL ACCEPT(23,62,HOLD,SK,SK,SK) 
CALL DISPLAY(23,10,' : 


Py ,SK,SK,SK) 
CALL DISPLAY(23,45,' , 
. ,SK,SK,SK) 
GOTO 30 
END IF 
CONTINUE 


DO 48 I=1,NUM_RATING 
OUTYEAR(YEAR,1,RATING_INDEX(1),5) = PROGRAMB(1) 


CALL CHANGE_SCREEN(CL,SK,SK) 


RETURN 
END 
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SUBROUTINE CHECK TO SEE IF NEW ALLOC 


This subroutine asks the user if the SAM allocation matrix being used 
in this run should be saved on disk or not. 


OUTYEAR(OUTY+1,LOS,RATE,PROG) 


NEW_SAM(20,RATE) 


TOT(OUTY) 


This matrix has the LOS 1 
filled in for each of the 
outyears with changes made to 
SAMS. The SAMS allocations for 
each outyeor will be extracted 
to create a new allocation. 


This matrix will store the new 
SAM allocation to be saved. 


This stores the sum of all the 
ratings for each outyear. It 
is the denominator. 


SUBROUTINE CHECK_TO_SEE_IF_SAVE_NEW_ALLOC (OUTYEAR) 


INCLUDE '"CNA2:[CORLISSG.FORCEJ]SCREEN_PARAMETERS.FOR’ 


INCLUDE 'CNA2:[CORLISSG.FORCE]PARAMETERS 


FOR’ 


REAL OUTYEAR(OUTY+1,LOS,RATE,PROG), NEW_SAM(2@,RATE), TOT(OUTY,) 


CHARACTER ANS 


CHARACTER*#5@ FILEN 
CHARACTER®25 NAME 


CALL CHANGE_SCREEN(CL,SK,SK) 


CALL DISPLAY(10,10,'’Would you like to save this allocation (’ 


* SkK,SK,SK) 
CALL DISPLAY(1@,50,'Y’,BO,SK,SK) 
CALL DISPLAY(10,51,’es or’,SK,5K,SK) 
CALL DISPLAY(1@,57,'N’,BO,SK,SK) 
CALL DISPLAY(1@,58,'0)?’.SK,SK,SK) 


CONTINUE 
CALL ACCEPT(1@,62,ANS,80,SC,SK) 


IF (ANS .NE. 'N’ .AND. ANS .NE. ‘Y' (AND. 


. ANS .NE. ‘y') THEN 
GOTO 5 
END IF 


IF (ANS .EQ. 'N’ .OR. ANS .EQ. ‘n') THEN 
GOTO 999 
END IF 


CALL DISPLAY(14,5,'Enter a name to save 


D-83 


ANS .NE. ‘n' . AND. 


this allocation under’, 


* SK ,SK,SK) 
18 CONTINUE 
NAME = ' 
CALL ACCEPT(14,48,NAME,BO,NE,.SK) 


IF (NAME .E£Q. ° ') THEN 
GOTO 10 
END IF 


FILEN = °SAM_’//NAME 
OPEN(UNIT=60, STATUS='NEW' ,FILE=FILEN, FORM=’ UNFORMATTED', ERR=10) 


C Compute the total over ratings for each outyear. Creating the denominator 
DO 20 J=1,RATE 
DO 20 I]=1,0UTY 
20 TOT(!) = TOT(1) + OUTYEAR(I+1,1,/,5) 


C Computing the new SAM allocation matrix. 
DO 30 v21,RATE 
DO 30 J#1,0UTY 
IF (TOT(I) .GT. @.®) THEN 
NEW_SAM(I,J) = OUTYEAR(1I4+1,1,3,5) / TOT(I) 
ELSE 
NEW_SAM(I,J) = 0. 
END IF 
3a CONTINUE 


C Making eoch yeor after OUTY equal to OUTY, up to 20 outyeaors. 
DO 40 Jval,RATE 
DO 4@ I*OUTY+1,20 
40 NEW_SAM(I,J) = NEW_SAM(OUTY,J) 


WRITE(60) NEW_SAM 
CLOSE( UNI T=6@) 


999 CONTINUE 


RETURN 
END 


D-84 


rd 


This is the moin subroutine of 


up to take 
progrom, then transition 
to create the outyear 


TRANS(LOS,RATE,PROG) 


HIST(LOS,RATE,PROG) 


OUTYEAR(OUTY+1,LOS,RATE,PROG) 


ea a a a a a we ee owe = 


SUBROUTINE TRANSISTION(OUTYEAR ) 
IMPLICIT NONE 


INCLUDE 
INCLUDE 


INTEGER I, J, K, L 


the program. 
the history from the most 
it using the percents 


is set 
into the 


This subroutine 
read it 
into the program, 


recent year, 


read 


inventories. 


These variables are used as indexes 
into arrays. 


read into this subroutine 
the continuation 
to transition the 


This array is 
ond it contains 


which are used 


rates 


history. 

This orray is read into this subroutine 
and contains the history for the 

most recent year. This dato will be 
loaded into the first outyear dimen. of 
the OUTYEAR orray. 

OUTYEAR coming into this subroutine 
contains onty the LOS 1 for each of the 


outyears. In this subroutine the 
History will be toaded into the outyeor 
1 dimension and the the transition rates 


will be opplied to fill up this arrray. 
This is where the simulated results are 
stored. 


me a a a a a we eee 


‘CNA2: [CORLISSG. FORCE JSCREEN_PARAMETERS . FOR’ 
'CNA2: [CORLISSG. FORCE ]PARAMETERS_RES. FOR’ 


REAL TRANS(LOS,RATE,PROG), OUTYEAR(OUTY+1,LOS,RATE,PROG), 


* HIST(LOS,RATE,PROG) 


CHARACTER*®2 CHAR_NUM 
CHARACTER*#25 FILEN 


CALL CHANGE_SCREEN(CL,SK,SK) 


CALL DISPLAY(10,15, Please wait 


while simulation takes place’, 


be BO,NE,SK) 


OPEN(UNIT#59,STATUS='OLD' ,READONLY, FORM=’UNFORMATTED’, 
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20 


30 


FILE='CNA2: [CORLISSG FORCE DAT_RES]TRANS_RES DAT’) 
READ(59) TRANS 
CLOSE(UNIT#=59) 


OPEN(UNIT=59,STATUS#=’OLD’ ,READONLY,FORM=’UNFORMATTED', 
FILEm'CNA2:([CORLISSG.FORCE.DAT_RESJHIST_RES.DAT') 

READ(59) HIST 

CLOSE(UNIT=59) 


DO 18 J=1,LOS 
DO 10 K=1,RATE 
DO 10 L=1,PROG 
OUTYEAR(1,J,K,L) = HIST(J.K.L) 


DO 30 I=1,0UTY 
DO 3@ L=1,PROG 
DO 3@ K=1,RATE 
DO 20 J=1,LOS-1 
OUTYEAR(I+1,J+1,K,L) = OUTYEAR(I,U,K,L) ® TRANS(J,K,L) 


CONTINUE 


OUTYEAR(I+1,LOS,K,L) = OUTYEAR(I+1,LOS,K,L) + 
OUTYEAR(I,LOS,K,L) * TRANS(LOS,K,L) 


CONTINUE 

OPEN(UNIT=59,STATUS=’NEW’ , FORM='UNFORMATTED’, 
FILE='OUTYEAR_RES.DAT') 

WRITE(59) OUTYEAR 

CLOSE(UNIT=59) 

CALL CHANGE_SCREEN(CL, SK, SK) 


RETURN 
END 
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SacUB REO Uo Tyal ON ok ADO PAYGRAODE 


This subroutine is used to restructure the OUTYEAR orray so it can 


be compared to requirements. The OUTYEAR array will be collapsed over 
program and LOS, and paygrade will be added. 
Pee CORK iEeoM These variables are used as indexes 


into orrays. 


OUTYEAR(OUTY+1,LOS,RATE,PROG) This array is passed into this 
subroutine and it contains the 
simulated results. 


PAYGRADE(LOS,RATE,PROG,PAYGRADE) This array is read into this 
subroutine and it contains percents 
which show how paygrade breaks out of 
the simulated inventory. 


SUM(OUTY,RATE,PAYGRADE) This array is created by collapsing 
out Program and LOS and adding paygrade 
to the outyear inventory. Used for 
comparing to requirements. 


SUBROUTINE ADO_PAYGRADE(OUTYEAR, SUM) 
IMPLICIT NONE 


INCLUDE ‘CNA2:[CORLISSG.FORCE]SCREEN_PARAMETERS. FOR’ 
INCLUDE ‘CNA2:[CORLISSG.FORCE]PARAMETERS_RES.FOR' 


INTEGER I, J. K, Lb, M 


REAL OUTYEAR(OUTY+1,LOS,RATE,PROG), PAYGRADE(LOS,RATE,PROG,PAYG), 
SUM(OUTY,RATE,PAYG) 


CHARACTER*®2 CHAR_NUM 
CHARACTER#25 FILEN 


CALL CHANGE_SCREEN(CL.SK,SK) 
CALL DISPLAY(1@,15,'Please wait while paygrade added’ ,B0,SK,SK) 


OPEN (UNI T#=56,STA1ILS='OLD’,READONLY, FORM='UNFORMATTED' , 
FILE='CNA2:[CORLISSG. FORCE .DAT_RES]PAYGRADE_RES. DAT’) 

READ(56) PAYGRADE 

CLOSE(UNIT=56) 


DO 18 M=1,PAYG 
DO 18 L=1,PROG 
DO 1@ K=1,RATE 
00 18 J#1,L0S 
DO 1@ I=#2,0UTY+1 
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CE ee ee ee ee ee ee ee) a ae oe oe ae ae ee ae ae eo 


10 SUM(I-1,K,M) = SUM(I-1,K.M) + 
* (OUTYEAR(I.J.K.L) * PAYGRADE(J,K,L,M)) 


CALL CHANGE_SCREEN(CL,SK,SK) 


RETURN 
END 
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9AAAAMAAMNAANAANAANANMNAMAANAANANMNAMDANAAMAANAAMDAAMAAMAAAAAAAANAAMAAMD MA AMAMNAAADAMH MAA AMA HA AA AOA AAO AO oO oO Oo 


SoUNIB Re 0.0) he aT UNE 


This subroutine is used to write out to the screen and to ao disk 
file the results of the simutation. The simuiated resuits will 
be compared to the NAVY requirements. 


RATING_INDEX(RATE) 


NUM_RAT ING 


OUT 


SAMS(OUTY) 


OTHER(OUTY) 


LOSSES(OUTYEAR, RATE, PROG-2) 


TOT (PROG-2) 


PEQ(20,RATE,PAYG) 


SUM(OUTY, RATE, PAYG) 


S(OUTY+1,RATE+1,PAYG+1) 


SR(OUTY+1,RATE+1,PAYG+1) 


DIFF (OUTY+1,RATE+1,PAYG+1) 
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This array is used to store which 
ratings the user has selected to view 
on the terminal. 


This is a count of how many rotings the 
user selected to view. 


These variables are used as indexes 
into arrays. 


This stores tne year thot the user 
selected for viewing on the terminal. 


This is used to keep a count of where 
a page break is needed in the output. 


This array is used to store the numbers 
input by the user for each outyeor. 
The numbers are for new SAM recruits. 


This array contains The user inputs for 
new recruits into the OTHER program. 


This array was read into the program 
and it contains the Active Simulation 
losses for each outyeor. 


This array is used to compute the 
totals for the LOSSES array by program. 


This array is read into the program in 
this subroutine and it contains the 
NAVY requirments. 


This array is passed into this 
subroutine and it contains the simulated 
results for each outyear by Rate ond 
Paoygrade. 


This array is the same os SUM except 
that Totals have been added. 


This array is the same as REQ except 
that Totals have been added. 


This array is computed by subtracting 
SR from S in each cell. 


eee ee ee a ee Pe 


Cc s 
Cc RATIOCOUTY+1,RATE+1,PAYG+1) This array is computed by dividing 
Cc DIFF by SR ar every cell where SR > @ @ ) 
‘ 
a 


SUBROUTINE WRITE_RESULTS(SUM, SAMS, OTHER, LOSSES ,ACTFILE) 


IMPLICIT NONE 


INCLUDE *CNA2:[CORLISSG. FORCE ]PARAMETERS_RES. FOR’ ; 
INTEGER I, J, K, L, OUT, REQ(2@,RATE,PAYG), CNT, - 
4 SAMS(OUTY), OTHER(OUTY), RATING_INDEX(RATE), NUM_RATING 


| 
) 
\ 
a 
INCLUDE 'CNA2:[CORLISSG.FORCE]SCREEN_PARAMETERS. FOR’ 
| 
REAL SUM(OUTY,RATE,PAYG), DIFF(OUTY+1,RATE+1,PAYG+1), 7 


‘ RATIO(OUTY+1,RATE+1,PAYG+1), S(OUTY+1, RATE+1,PAYG+1), 
. SR(OUTY+1,RATE+1,PAYG+1), LOSSES(OUTY, RATE, PROG-2) 
‘ TOT(PROG-2) 


| 
[ 
CHARACTER HOLD, ANS | 
CHARACTER®2 CHAR_NUM, YR_SEL | 
CHARACTER*®8 RATE_LABEL ) 
CHARACTER®25 NAME : 
CHARACTER*®5@ FILEN, ACTFILE | 


CALL DISPLAY(1@,15,’Please woit while results are written to disk’ 
) ,B0O,SK,SK) 


C--- Initializing 


DO 5 I=1,OUTY+1 
DO 5 J=t,RATE+1 
DO 5 K=1,PAYG+1 
S(I,u,K) = @.2 
SR(I,J,K) = @.@ 
DIFF(I,J,K) = 0.2 
5 RATIO(I,J,K) = 0.8 


OPEN(UNIT#50,FILE='CNA2:[CORLISSG. FORCE .DAT_RES]REQ_RES.DAT’, 


* FORM='’UNFORMATTED’ ,STATUS=’OLD’ ,READONLY ) 
READ(5@) REQ 
CLOSE(UNIT=5Q@) 
CBee asa seee ee ee ee ee a Se ee a ae eee ee ae eee Se oe 
Cc The 10 loops wil! sum up everything needed 


DO 10 K=1,PAYG 
DO 10 J=m1,RATE ' 
DO 10 I=#1,0UTY 


S(I,uJ,K) = S(1,u,K) + SUM(I,J,K) 
S(1,RATE+1,K) = S(1,RATE+1,K) + SUM(I,Ju,K) 
S(1,Ju,PAYG+1) = S(1,J,PAYG+1) + SUM(I,J,K) 
S(OUTY+1,U,K) = S(OUTY+1,J3,K) + SUM(I,J,K) 
S(OUTY+1,RATE+1,K) = S(OUTY+1,RATE+1,K) + SUM(I,J,K) 
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S(1, RATE+1,PAYG+1) = S(1,RATE+1,PAYG+1) + SUM(I,J,K) 
S(OUTY+1,JU,PAYG+1) = S(OUTY+1,J3,PAYG+1) + SUM(I,JU,K) 
S(OUTY+1,RATE+1,PAYG+1) = S(OUTY+1,RATE+1,PAYG+1) + SUM(I,J,K) 


SR(I1,J.K) = SR(1,J,K) + REQ(I,J,K) 
SR(1,RATE+1,K) = SR(1,RATE+1,K) + REQ(I,J,K) 
SR(I,J,PAYG+1) = SR(1,3,PAYG+1) + REQ(1,J.K) 
SR(OUTY+1,U,K) = SR(OUTY+1,0,K) + REQ(1,u,K) 
SR(OUTY4+1,RATE+1,K) ® SR(OUTY+1,RATE+1,K) + REQ(I,J,K) | 
SR( 1. RATE+1,PAYG+1) = SR(1,RATE+1,PAYG+1) + REQ(I,J,K) 
SR(OUTY+1,J3,PAYG+1) = SR(OUTY+1,JU,PAYG+1) + REQ(I,J.K) 
SR(OUTY+1,RATE+1,PAYG+1) = SR(OUTY+1,RATE+1,PAYG+1)+ REQ(I,J.K) 
10 CONTINUE 
Cc aw ew ee ew we oe ee a we ee a a we we wn wn wn nw a wn wo ow we a ew ee eo a ee eee 
c The next section is for creating a disk file that shows the 
Cc comparison of simulated results ‘to requirements 
OPEN (UNIT=66,STATUS#=’NEW’ ,FILE=’RESERVE.DAT’ ) 
DO 20 K=1,PAYG+1 
00 20 Jai1,RATE+1 
DO 20 I[=1,0UTY+1 
DIFF(I,J.K) = S(I,u,K) - SR(I,U,K) 
IF (SR(I1,J,K) .EQ. @) THEN 
RATIO(I,J,K) = 0. 
ELSE 
RATIO(I,J,K) = DIFF(I,J,K) / SR(I,J,K) 
END IF 
20 CONTINUE 
DO 5@ I=#1,0UTY 
WRITE(66,120) 
WRITE (66,100) 
WRITE (66, 100) 
WRITE(66,110) I + (CFY - 1) 
WRITE(66,100) 
WRITE (66, 100) 
WRITE(66, 130) 
WRITE(66, 100) 
WRITE(66,14@) SAMS(I), OTHER(I) 
WRITE(66, 100) 
WRITE(66,180@) ACTFILE 
WRITE(66, 120) 
WRITE(66, 150) 
WRITE(66, 100) 
WRITE(66,1702) 
DO 31 K=#1,4 
31 TOT(K) = @.2@ 


D0 33 J=1, RATE 
WRITE(66,9@) RATE_LABEL(J),(LOSSES(I,u,K),K=e1,4) 
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32 
33 


q0g0gnN Ngan naanaanananaAa AAA Aa 


40 


45 


5e@ 


35 


DO 32 Ke1,4 
TOT(K) = TOT(K) + LOSSES(I,J,K) 
CONTINUE 
WRITE(66,1200) 
WRITE(66,.9@) ' Total’, (TOT(K),K=1,4) 


WRITE(66,12@) 
WRITE(66, 100) 
WRITE(66,160) 
WRITE(66, 10@) 


CNT = @ 
DO 40 J=1,RATE 
CNT = CNT + 1 


IF (CNT <@T. 27) THEN 
WRITE(66,120) 
CNT = 1 

END IF 


IF (CNT .NE. 1) THEN 
WRITE(66,1@0) 
END IF 


DO 3@ K=1,PAYG 
WRITE(66,90) RATE_LABEL(J), S(I,J,K), 
SR(I,J,K), DIFF(I,J,K), RATIO(I,J,K) 
CONTINUE 


WRITE(66, 100) 

WRITE(66,90) RATE_LABEL(J), S(I,uU,PAYG+1), 
SR(1,u,PAYG+1), DIFF(I,JU,PAYG+1), 
RATIO(1,¥,PAYG+1) 


CONTINUE 


WRITE(66, 100) 


DO 45 K=1,PAYG 
WRITE(66,90) ‘OUTY PG ',S(I1,RATE+1,K),SR(I,RATE+1,K), 
DIFF(I1,RATE+1,K), RATIO(1,RATE+1,K) 
CONTINUE 


WRITE(66, 10) 

WRITE(66,90) ‘TOTAL OY’, S(1,RATE+1,PAYG+1), 
SR(1,RATE+1,PAYG+1), DIFF(1,RATE+1,PAYG4+1), 
RATIO(1I,RATE+1,PAYG+1) : 


CONTINUE 


WRITE(66, 100) 
DO 55 K=1,PAYG 
WRITE(66,90) ‘TOT PG ‘, S(7,RATE+1,K), SR(7,RATE+1,K), 
DIFF(7,RATE+1,K), RATIO(7,RATE+1 ,K) 
CONTINUE 
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WRITE(65, 100) 


WRITE(66,9@) ‘TOT TOT °', S(OUTY+1,RATE+1,PAYG41), 
. SR(OUTY+1,RATE+1,PAYG4+1), DIFF (OUTY4+1 ,RATE+1,PAYG+1) 
° RATIO(CUTY+1.RATE+1, PAYG+1) 


CLOSE (UNIT=66) 


C Writing out the sums of the simuioted results to disk for use in the 
C Compare program. 


CALL DISPLAY(13,5.'Enter o filename for storing the results’, 
‘ Sk ,SK,SK) 
CALL DISPLAY(13,46,'(For use later in the compare run)’,SK,SK,SK) 


200 CONTINUE 


NAME = ' 
CALL ACCEPT(15,25,NAME,B80,NE,SK) 


IF (NAME .EQ. ° ') THEN 
GOTO 200 
END IF 


FILEN = ‘RES_'//NAME 


OPEN(UNIT@67,STATUS='NEW' ,FILESFILEN, FORM™'UNFORMATTED ' ) 
WRITE(67) S$ 
CLOSE(UNI T=67) 


90 FORMAT(4X,A8,4F17.3) 

100 FORMAT(1X) 

118 FORMAT(30X,’°Y EAR ',14) 

120 FORMAT(‘?") 

130 FORMAT(22X, ‘Inputs for the outyear ore’) 

140 FORMAT(20X,'Sams = ',16,’' Others = ',16) 

15@ FORMAT(2@X,' Active losses by rating are:’) 

160 FORMAT(12x,° Simulated’,’ , Requirements’, 
® : Difference’,' Percent Diff’) 

178 FORMAT(16X,'4Y0+5&6YO0+PS+TARS',’ Active Mariners’, 
* ; Sea Coltlege’,’ Other’) 

180 FORMAT(15X,'Active loss file being used is: ',A5®) 

999 CONTINUE 


CALL CHANGE_SCREEN(CL,SK,SK) 


RETURN 
END 
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